Как создать файл XML в кодировке UTF-8 из VBA в MS Access?

Question

Для этого примера у меня есть две функции, которые записывают строки в xml -файл. Обе функции используют набор записей для извлечения данных для печати в xml -файл.

До настоящего времени экспортированные файлы были безупречны и принимались приложением, которое должно обработать файл.

Однако в одном или нескольких полях из последнего созданного файла есть такие символы, как «€» или «é». Когда файл xml был обработан, я получил сообщение об ошибке из-за неправильного кодирования UTF-8 файла xml.

Найдено следующее SO topi c. Однако, используя этот «ADODB.STREAM», я не могу понять, как сделать так, чтобы несколько функций записывали в один и тот же поток, чтобы сделать один файл для экспорта. Как я могу переписать пример кода ниже, используя «ADODB.STREAM» для правильного кодирования?

Я читал о кодировании БД доступа в UTF-8, это не вариант, потому что таблицы для RecordSet являются связанными таблицами, которые мне не принадлежат.

«Старый» код для создания xml -файла без кодировки utf-8.

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