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

【问题标题】：How to create an UTF-8 encoded XML file from VBA in MS Access?如何在 MS Access 中从 VBA 创建 UTF-8 编码的 XML 文件？
【发布时间】：2020-05-05 06:14:39
【问题描述】：

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

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

但是，在最后创建的文件的一个或多个字段中，有诸如“€”或“é”之类的字符。处理 xml 文件时，我从应用程序收到一个错误，即 xml 文件未正确 UTF-8 编码。

找到以下 SO topic。但是，使用这个“ADODB.STREAM”我无法弄清楚如何将多个函数写入同一个流以生成一个要导出的总文件。如何使用“ADODB.STREAM”重写下面的代码示例以正确编码？

我已阅读有关以 UTF-8 编码 Access DB 的信息，这不是一个选项，因为 RecordSet 的表是不属于我的链接表。

用于创建没有 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 |
+----------------+---------------+

tbl线：

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

【问题讨论】：

在您链接到的答案中有一个对象fsT，它是写入内容的流。在“开始”过程中创建它并将其作为第二个参数传递给“恢复” - 在恢复中，您可以使用它来编写附加内容。
@TimWilliams 我不熟悉在多个函数之间传递对象。你能用一些示例代码向我展示吗？

标签： xml vba ms-access utf-8 export

【解决方案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

【讨论】：