VBA-Makro "utf-8" xml schafft, aber nicht wirklich

Question

Beispiel beschädigter Text:

Prokofjew, Sergej, 1891-1953. | Simfonii︠a︡-kont︠s︡ert

zu

Prokofjew, Sergej, 1891-1953. | Simfonii? A? -Kont? S? Ert

So verwende ich ein VBA-Makro, um zu übertragen, was ursprünglich eine Google-Tabelle zu xml über Excel war. Obwohl ich versucht habe, Excel in erweiterten Optionen zu sagen, um in utf-8 zu speichern, und obwohl das XML in utf 8 gedruckt wird, ist offensichtlich etwas inkorrekt. Dies ist die VBA, die ich glaube, ich habe von Stackoverflow Monaten vor an erster Stelle:

Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFileName As String) 
    Dim Q As String 
    Q = Chr$(34) 

    Dim sXML As String 

    sXML = "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>" 
    sXML = sXML & "<rows>" 


    ''--determine count of columns 
    Dim iColCount As Integer 
    iColCount = 1 
    While Trim$(Cells(iCaptionRow, iColCount)) > "" 
     iColCount = iColCount + 1 
    Wend 

    Dim iRow As Integer 
    iRow = iDataStartRow 

    While Cells(iRow, 1) > "" 
     sXML = sXML & "<row id=" & Q & iRow & Q & ">" 

     For icol = 1 To iColCount - 1 
      sXML = sXML & "<" & Trim$(Cells(iCaptionRow, icol)) & ">" 
      sXML = sXML & Trim$(Cells(iRow, icol)) 
      sXML = sXML & "</" & Trim$(Cells(iCaptionRow, icol)) & ">" 
     Next 

     sXML = sXML & "</row>" 
     iRow = iRow + 1 
    Wend 
    sXML = sXML & "</rows>" 

    Dim nDestFile As Integer, sText As String 

    ''Close any open text files 
    Close 

    ''Get the number of the next free text file 
    nDestFile = FreeFile 

    ''Write the entire file to sText 
    Open sOutputFileName For Output As #nDestFile 
    Print #nDestFile, sXML 
    Close 
End Sub 

Sub test() 
    MakeXML 1, 2, "C:\Users\Adam Horvath\Documents\~CODE\prokooutputtitleUTF8.xml" 
End Sub 

Ich denke, dass die Lösung beinhaltet in einer anderen Art und Weise zu der XML-Datei zu schreiben, aber was auf diese Weise ist, nicht sicher.

Answer 1

Verwenden Sie das Objekt MSXML von VBA, um Ihr XML-Dokument zu erstellen und Zeichenkettenwerte zum Erstellen von XML nicht zu verketten, und vermeiden Sie sogar einen Textdatei-Dump. Bei diesem Ansatz gibt es Prozeduren für createElement(), , appendChild() und xmldoc.Save(). Und speziell für Ihre Bedürfnisse, die createProcessingInstruction() ermöglicht Ihnen, Codierung zu spezifizieren. Beachten Sie, dass der Standard immer Version 1.0 und Codierung wie UTF-8 ist. Daher kann die Verarbeitungsanweisung hier redundant sein.

Momentan wird Ihre Textdatei mit UTF-8-Dumps gespeichert, aber es ist möglicherweise keine vollständige XML-Formatkodierung, sondern das ANSI-Standardtextformat. In der Tat könnten Sie alles angeben und Text-Dump würde entsprechen, würde aber mit einem XML-Objekt fehlschlagen.

Vor der Endung wird eine XSLT Identity Transformation hinzugefügt, um die Ausgabe mit Zeilenumbrüchen und Einrückung auszudrucken, um die Ausgabe des XML-Dokuments in einer Zeile zu vermeiden. Sie werden feststellen, dass ein solches XSLT eine String-Repräsentation ist, aber in ein korrektes XML-Dokument geladen wird. Andernfalls können Sie XSLT extern als .xsl-Datei laden (was übrigens eine wohlgeformte .xml-Datei ist).

Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFileName As String) 
    ' REFERENCE: Microsoft XML V6.0 
    Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60 
    Dim pi As MSXML2.IXMLDOMProcessingInstruction 
    Dim root As IXMLDOMElement, rowNode As IXMLDOMElement, loopNode As IXMLDOMElement 
    Dim idAttrib As IXMLDOMAttribute 

    ' PROCESSING INSTRUCTION 
    Set pi = doc.createProcessingInstruction("xml", " version=""1.0"" encoding=""UTF-8""") 
    doc.appendChild pi 

    ' DECLARE XML DOC OBJECT 
    Set root = doc.createElement("rows") 
    doc.appendChild root 

    ''--determine count of columns 
    Dim iColCount As Integer 
    iColCount = Cells(7, Columns.Count).End(xlToLeft).Column 

    Dim iRow As Integer 
    iRow = iDataStartRow 

    Dim icol As Integer 

    While Cells(iRow, 1) > "" 

     ' ROW NODE 
     Set rowNode = doc.createElement("row") 
     root.appendChild rowNode 

     ' ID ATTRIBUTE 
     Set idAttrib = doc.createAttribute("id") 
     idAttrib.Value = iRow 
     rowNode.setAttributeNode idAttrib 

     ' LOOP NODE 
     For icol = 1 To iColCount - 1 
      Set loopNode = doc.createElement(Trim$(Cells(iCaptionRow, icol))) 
      loopNode.Text = Trim$(Cells(iRow, icol)) 
      rowNode.appendChild loopNode 
     Next icol 

     iRow = iRow + 1 
    Wend 

    ' PRETTY PRINT RAW OUTPUT 
    xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _ 
      & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _ 
      & "    xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _ 
      & "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _ 
      & "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _ 
      & "   encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _ 
      & " <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _ 
      & " <xsl:copy>" _ 
      & " <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _ 
      & " </xsl:copy>" _ 
      & " </xsl:template>" _ 
      & "</xsl:stylesheet>" 

    xslDoc.async = False 
    doc.transformNodeToObject xslDoc, newDoc 
    newDoc.Save sOutputFileName 

End Sub