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

Question

For this sample, I have two functions that write lines to an xml-file. Both functions use a recordset to retrieve data to be printed to the xml-file.

Until now, the exported files were perfect and were accepted by the application that needs to process the file.

However, in one or more fields from the last created file, there are characters like "€" or "é". When the xml-file was processed, I got an error from the application that the xml-file was not properly UTF-8 encoded.

Found the following SO topic. However, using this "ADODB.STREAM" I can't figure out how to have multiple function writing to the same stream to make one total file to export. How can I rewrite the code sample below using the "ADODB.STREAM" to encode properly?

I have read about encoding the Access DB in UTF-8, this is not an option because the tables for the RecordSet are linked tables that are not owned by me.

The 'old' code for creating the xml-file without utf-8 encoding.

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

Tables are as follows:

tblHdr:

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

tblLine:

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

In the answer you linked to there is an object `fsT` which is the stream to which content is written. Create that in the "Start" procedure and pass it as a second argument to "Resume" - in Resume you can use that to write the additional content. — Tim Williams, Jan 18 '20 at 17:14
@TimWilliams i'm not familiar with passing an object between multiple functions. Can you show that to me with a little sample code? — Sunfile, Jan 18 '20 at 17:24

score 2 · Accepted Answer · answered Jan 18 '20 at 17:37

Like this:

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

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

1 Answers1