如何以 UTF-8 格式將 VBA 中的工作表/列導出到 XML

Question

我已經編寫了一個宏，它在某個工作表的 A 列中輸出 xml 行（具有正確的格式）。 因此，該表中的每一行都應對應於 xml 文件中的 1 行。 如果我將此列復制粘貼到記事本中並將其另存為.xml（在刪除自動放置在每行之前和之后的“-tags”之后），我就有了我需要的文件。宏應該生成幾個文件，所以它是不實際地為每個文件手動執行此操作。

我找到了以下代碼來完成保存工作：

strFileName = Application.ActiveWorkbook.Path & "\" & NameOfTheFile & ".xml"
Sheets(NameOfSheetContainingData).SaveAs Filename:=strFileName, FileFormat:=xlTextPrinter, CreateBackup:=False

這完美地工作，除了 UTF-8 格式。 我在 excel 中有一個“é”，它在 xml 文件中變成了一個“xE9”。

我會非常感激有人可以幫助我解決這個問題:)

Answer 1

嘗試

Sub SaveUTF8()

   Const NameOfTheFile = "test"
   
   Dim FSO, ts, ar, strFilename As String, s As String
   Dim i As Long, t0 As Single: t0 = Timer

   strFilename = ActiveWorkbook.Path & "\" & NameOfTheFile & ".xml"

   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set ts = FSO.createTextfile(strFilename, 1, 1) ' oversrite, utf8
 
   ar = Sheets(1).UsedRange.Columns(1).Value2 'NameofSheetContainingData

   For i = LBound(ar) To UBound(ar)
       s = s & ar(i, 1) & vbCrLf
       If i Mod 1000 = 0 Then
           ts.write s
           s = ""
       End If
   Next
   ts.write s
   ts.Close
   MsgBox strFilename & " created in " & Int(Timer - t0) & " seconds"
   
End Sub

選擇

Sub SaveUTF8_2()

    Const NameOfTheFile = "test"
   
    Dim strFilename As String, cell As Range
    Dim t0 As Single: t0 = Timer

    strFilename = ActiveWorkbook.Path & "\" & NameOfTheFile & ".xml"

    Dim objStream
    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        .Type = 2 'adTypeText
        .Open
        .Charset = "UTF-8"
        For Each cell In Sheets(1).UsedRange.Columns(1).Cells
            .writetext cell.Value2, 1 'adWriteLine
        Next
        .Position = 0
        .SaveToFile strFilename, 2  'adSaveCreateOverWrit
    End With
    objStream.Close
    MsgBox strFilename & " created in " & Int(Timer - t0) & " seconds"

End Sub

Sub testdata()
    Sheet1.Range("A1:A300000").Value2 = _
    "<tag atr1=""attribute one"" atr2=""attribute two"">some text here ééé</tag>"
End Sub

更新 - 批量寫入 1000 行

update2 - 添加了替代方案