Hi All,

I have a requirement to export data from an existing MS Access query into XML using VB6 which I will then use to update a wordpress site with the addon WP All Imports.

Test code below seems to work fine however when I try importing the XML it is appearing as one row even though the preview in XL shows a perfectly formatted XML file with multiple rows!

Any ideas what I might be missing or could try differently? Another ways to do this?

thanks, Jay


Code:
Private Sub test_Click()
       
    Dim RS As ADODB.Recordset
    Set RS = CreateObject("ADODB.Recordset")
    
    With RS
    .ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbSourceFile & ";Jet OLEDB:Database Password=12345!"
    .Source = ("ExportQuery")
    .Open
    End With
    
    CustomSaveXML RS, "sample2.xml"
    RS.Close
         
        
End Sub
Code:
Private Sub CustomSaveXML( _
    ByVal Recordset As ADODB.Recordset, _
    ByVal FilePath As String)
    Dim Stream As IUnknown
    Dim HRESULT As HRESULT
    Dim Attributes As SAXAttributes60
    Dim Writer As MSXML2.MXXMLWriter60
    Dim Handler As MSXML2.IVBSAXContentHandler
    Dim Field As ADODB.Field
    Dim StringValue As String

    Set Stream = Nothing 'Force creation on 64-bit Windows.  Not sure why
                         'this is required or why it works.
    HRESULT = SHCreateStreamOnFile(StrPtr(FilePath), _
                                   STGM_CREATE _
                                Or STGM_WRITE _
                                Or STGM_SHARE_EXCLUSIVE, _
                                   Stream)
    If HRESULT <> S_OK Then
        Err.Raise &H80044900, _
                  "CustomSaveXML", _
                  "SHCreateStreamOnFile error " & Hex$(HRESULT)
    End If
    Set Attributes = New MSXML2.SAXAttributes60
    Set Writer = New MSXML2.MXXMLWriter60
    Set Handler = Writer
    With Writer
        .omitXMLDeclaration = True
        .standalone = True
        .disableOutputEscaping = False
        .indent = True
        .encoding = "utf-8"
        .output = Stream
    End With
    With Handler
        .startDocument
        .startElement "", "", "data", Attributes
        Do Until Recordset.EOF
            With Attributes
                For Each Field In Recordset.Fields
                    Select Case VarType(Field.Value)
                        Case vbNull
                            'Force as empty String:
                            StringValue = ""
                        Case vbString
                            StringValue = Field.Value
                        Case Else
                            'This converts to a String value using the
                            'Invariant Locale:
                            StringValue = LTrim$(Str$(Field.Value))
                    End Select
                    .addAttribute "", "", Field.Name, "", StringValue
                Next
            End With
            .startElement "", "", "row", Attributes
            .endElement "", "", "row"
            Attributes.Clear
            Recordset.MoveNext
        Loop
        .endElement "", "", "data"
        .endDocument
    End With
End Sub