如何在 MS Access 中从 VBA 创建 UTF-8 编码的 XML 文件？

Question

对于这个示例，我有两个函数可以将行写入 xml 文件。这两个函数都使用记录集来检索要打印到 xml 文件的数据。

到目前为止，导出的文件是完美的，并被需要处理文件的应用程序接受。

但是，在上次创建的文件的一个或多个字段中，有“€”或“é”等字符。处理 xml-文件时，我从应用程序收到错误消息，指出 xml-文件未正确进行 UTF-8 编码。

找到以下 SO topic。但是，使用这个 "ADODB.STREAM" 我无法弄清楚如何让多个函数写入同一个流来制作一个完整的文件来导出。如何使用 "ADODB.STREAM" 重写下面的代码示例以正确编码？

我读过有关以 UTF-8 编码 Access DB 的内容，这不是一个选项，因为 RecordSet 的表是不归我所有的链接表。

'old' 代码用于创建没有 utf-8 编码的 xml 文件。

Public Function StartWritingTextFile()

' Declare variables
Dim curDB       As DAO.Database
Dim myFile      As String
Dim rst         As DAO.Recordset
Dim strSQL      As String

' Initialize variables
Set curDB = CurrentDb
myFile = CurrentProject.Path & "\ExportXML.xml"
strSQL = "SELECT * FROM tblHdr"
Set rst = curDB.OpenRecordset(strSQL)

Open myFile For Output As #1

Write #1, "<?xml version=""1.0"" encoding=""UTF-8""?>"

If Not rst.BOF And Not rst.EOF Then
    rst.MoveFirst
    Do Until rst.EOF = True
    Write #1, "<highestLevel>"
    Write #1, "<docTitle>" & rst!Title & "</docTitle>"
    Call ResumeWritingTextFile(rst!DocumentNumber)
    Write #1, "</highestLevel>"
    rst.MoveNext
    Loop
End If
Close #1

ExitFunction:
    rst.Close
    Set rst = Nothing
    Set curDB = Nothing
    Exit Function

ErrorHandler:
    Close #1
    GoTo ExitFunction

End Function

Public Function ResumeWritingTextFile(ByVal inDocNum As Variant)

    Dim curDB       As DAO.Database
    Dim rst         As DAO.Recordset
    Dim strSQL      As String

    Set curDB = CurrentDb
    strSQL = "SELECT * FROM tblLine WHERE DocumentNumber = '" & inDocNum & "'"
    Set rst = curDB.OpenRecordset(strSQL)

    Write #1, "    <lowerLevel>"

    If Not rst.BOF And Not rst.EOF Then
        rst.MoveFirst
        Do Until rst.EOF = True
        Write #1, "        <LineNumber>" & rst!LineNumber & "</LineNumber>"
        Write #1, "        <DetailOne>" & rst!DetailOne & "</DetailOne>"
        rst.MoveNext
        Loop
    End If

    Write #1, "    </lowerLevel>"

ExitFunction:
    rst.Close
    Set rst = Nothing
    Set curDB = Nothing
    Exit Function

ErrorHandler:
    Close #1
    GoTo ExitFunction

表格如下：

tblHdr:

+----------------+---------------+
| DocumentNumber | Title         |
+----------------+---------------+
| 123            | Document one  |
+----------------+---------------+
| 121239         | Document five |
+----------------+---------------+

tblLine:

+----------------+------------+-----------+
| DocumentNumber | LineNumber | DetailOne |
+----------------+------------+-----------+
| 123            | 1          | € hé      |
+----------------+------------+-----------+
| 121239         | 1          | Haha      |
+----------------+------------+-----------+
| 121239         | 2          | Test      |
+----------------+------------+-----------+

Answer 1

像这样：

Sub StartWriting()

    Dim fsT As Object
    Set fsT = CreateObject("ADODB.Stream")
    fsT.Type = 2 
    fsT.Charset = "utf-8"
    fsT.Open 
    fsT.WriteText "special characters: äöüß"

    ContinueWriting fsT, "SomeId"

    fsT.SaveToFile sFileName, 2

End Sub

Sub ContinueWriting(fs as Object, id as Variant)

    'do something with id

     fs.WriteText "In ContinueWriting"

End Sub

如何在 MS Access 中从 VBA 创建 UTF-8 编码的 XML 文件？

How to create an UTF-8 encoded XML file from VBA in MS Access?

xml

ms-access

vba

export

utf-8