• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Xml oluştururken Türkçe karakter sorunu

Katılım
13 Ekim 2017
Mesajlar
178
Excel Vers. ve Dili
2003-tr
Merhaba arkadaşlar;

Excel'den makro koduyla xml oluşturuyorum ama Türkçe karakterleri kod olarka gösteriyor. Replace ile değiştirip yapmak da istemiyorum. Kullandığım kod aşağıda. Önerilerinizi bekliyorum

Teşekkürler.

Kod:
Sub MGS5_Outxml()
Dim txtname, yol, filename, subs, BOM As String
Dim son, isay, x, ix, xml, kvar As Long
Dim FSO, Out As Object
Dim ilerleme As Single
Set FSO = CreateObject("Scripting.FileSystemObject")
BOM = ""
son = Cells(1048576, 1).End(xlUp).Row
yol = Sayfa2.Range("A2")
'------------ Make folder--------------
kvar = FSO.FolderExists(yol)
If kvar <> True Then
    FSO.CreateFolder yol
End If
'------------ pro ayarlar--------------
Application.ScreenUpdating = False
Application.DisplayAlerts = False
DoEvents ' userformun düzgün görünmesi için
'On Error Resume Next
'------------ karakter düzeltme--------------
Cells.Replace Chr(10), "
" ' satırbaşı xml koda dönüştür
Cells.Replace """", """ ' tırnak işareti xml koda dönüştür
Cells.Replace "…", "..." ' " karakteri
Cells.Replace "R&D", "R&D" ' & işaretini koda dönüştürür
Cells.Replace "Ar&Ge", "Ar&Ge" ' & işaretini koda dönüştürür
'------------ work--------------
For x = 2 To son
    If txtname <> Range("A" & x - 1) Then
        txtname = Range("A" & x)
        filename = yol & "\" & txtname
        Set Out = FSO.CreateTextFile(filename, True, False) '2.true ansi için
            Out.WriteLine BOM & ("<?xml version=" & """" & "1.0" & """" & " encoding=" & """" & "utf-8" & """" & "?>")
            Out.WriteLine ("<SubpFile xmlns:xsi=" & """" & "http://www.w3.org/2001/XMLSchema-instance" & """" & " xmlns:xsd=" & """" & "http://www.w3.org/2001/XMLSchema" & """" & ">")
            Out.WriteLine ("  <Entries>")
        isay = Application.WorksheetFunction.CountIf(Range("A" & x & ":A" & son), txtname)
        For ix = x To x + (isay - 1)
            'If Range("G" & ix) <> "" Then
                subs = Range("G" & ix)
                'Else
                'subs = Range("H" & ix)
              'End If
            Out.WriteLine ("    <Entry Id=" & """" & Range("B" & ix) & """" & " Priority=" & """" & Range("C" & ix) & """" & " Flags=" & """" & Range("D" & ix) & """" & " Unknown=" & """" & Range("E" & ix) & """" & " AdditionalLength=" & """" & Range("F" & ix) & """" & ">")
            Out.WriteLine ("      <Lines>")
            Out.WriteLine ("      <Line Text=" & """" & subs & """" & ">")
            Out.WriteLine ("          <Timing Start=" & """" & Range("H" & ix) & """" & " End=" & """" & Range("I" & ix) & """" & " />")
            Out.WriteLine ("        </Line>")
            Out.WriteLine ("      </Lines>")
            Out.WriteLine ("    </Entry>")
        Next ix
            Out.WriteLine ("  </Entries>")
            Out.WriteLine ("</SubpFile>")
        xml = xml + 1
    End If
    x = x + isay
Next x
'------------ END--------------
Cells.Replace "
", Chr(10) ' satırbaşı xml koda dönüştür
Cells.Replace """, """" ' tırnak işareti xml koda dönüştür
Cells.Replace "R&D", "R&D" ' & işaretini koda dönüştürür
Cells.Replace "Ar&Ge", "Ar&Ge" ' & işaretini koda dönüştürür
'--------------------------------------------------
Sayfa2.Range("B1").Value = xml
Sayfa2.Range("C1").Value = yol
End Sub
 
Son düzenleme:
"DOMDocument" sınıfını kullanın. Kullandığınız metot kullanışlı değil. Ayrıca özel karakter kodlarına da ihtiyacınız olmaz.

.
 
Zeki bey DOMDocument nedir bilmiyorum, ayrıca kullandığım metotun şu anda daha iyisini yazacak bilgide değilim. Yardımlarınızı rica ediyorum.
 
XML çevimek istediğiniz örnek listeyi ve örnek xml eklerseniz yardım almanız kolaylaşır.

.
 
Geri
Üst