Converting Excelsheet into XML file with XML elements having attributes

Question

I am new to VBA and to use VBA on excel and write a macro to export an xml file per row (see the example in the print screen): Excel Example

The Account should be an XML element and the transactionID should be an XML attribute of Account.

Example of Excel row 1 converted into a XML file: Example XML file

So far I have this following VBA code to convert an Excel row-wise into an xml file:

Sub test2XLStoXML()
 sTemplateXML = _
        "<?xml version='1.0'?>" + vbNewLine + _
        "<Account transactionId='???'>" + vbNewLine + "</Account>"
 
 Debug.Print sTemplateXML
 
 Set doc = CreateObject("MSXML2.DOMDocument")
 doc.async = False
 doc.validateOnParse = False
 doc.resolveExternals = False

 With ActiveWorkbook.Worksheets(1)
  lLastRow = .UsedRange.Rows.Count

  For lRow = 2 To 7
   sFile = "/Users/user/Documents/" & .Cells(lRow, 1).Value & ".xml"
   
   Dim sAccount As String
   Dim sTransactionId As String
   
   sAccount = CStr(.Cells(lRow, 2).Value)
   sTransactionId = CStr(.Cells(lRow, 3).Value)
   
   doc.LoadXML sTemplateXML
   doc.getElementsByTagName("Account")(0).appendChild doc.createTextNode(sAccount)
   doc.getElementsByTagName("Account")(0).appendChild doc.create???(sTransactionId)
   
   doc.Save sFile
  Next

 End With
End Sub

But I don't know how to code that the Attribute "transactionID" will get the dynamic values from the excel.

I am glad for some help.

Thanks in advance.

Answer 1

Something like this would work:

Option Explicit

Sub test2XLStoXML()

    Dim doc As Object, root As Object, sTemplateXML As String, sFile As String
    Dim sAccount As String
    Dim sTransactionId As String, el, el2, att, lRow As Long
    
    With ActiveWorkbook.Worksheets(1)
      
        For lRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
        
            sFile = "/Users/user/Documents/" & .Cells(lRow, 1).Value & ".xml"
            sAccount = CStr(.Cells(lRow, 2).Value)
            sTransactionId = CStr(.Cells(lRow, 3).Value)
            
            With EmptyDoc 'moved XML doc creation to separate function
                
                .appendchild .createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
                'root node with attribute
                Set el = .createnode(1, "Account", "")
                Set att = .CreateAttribute("transactionId")
                att.Value = sTransactionId
                el.Attributes.setnameditem att
                'child "val" node
                Set el2 = .createnode(1, "val", "")
                el2.appendchild .createtextnode(sTransactionId)
                el.appendchild el2
                .appendchild el
                
                'Debug.Print .XML
                .Save sFile
            End With
            
        Next lRow
    End With
     
End Sub

'create and return an empty XML document
Function EmptyDoc() As Object
    Dim doc As Object
    Set doc = CreateObject("MSXML2.DOMDocument")
    doc.async = False
    doc.validateOnParse = False
    doc.resolveExternals = False
    Set EmptyDoc = doc
End Function

EDIT: on a Mac it's probably easier to create and write out the XML as text -

Sub test2XLStoXMLString()

    Dim xml As String, sAccount As String
    Dim sTransactionId As String, lRow As Long, sFile As String
    
    With ActiveWorkbook.Worksheets(1)
      
        For lRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            sFile = "/Users/user/Documents/" & .Cells(lRow, 1).Value & ".xml"
            sAccount = CStr(.Cells(lRow, 2).Value)
            sTransactionId = CStr(.Cells(lRow, 3).Value)
            
            xml = "<?xml version=""1.0""?><Account transactionId=""{tId}""><val>{acct}</val></Account>"
            xml = Replace(xml, "{tId}", sTransactionId)
            xml = Replace(xml, "{acct}", sAccount)
            SaveToFile sFile, xml
            'Debug.Print xml
        Next lRow
    End With
     
End Sub

Sub SaveToFile(fPath As String, sContent As String)
    Dim ff
    ff = FreeFile
    Open fPath For Output As #ff
    Print #ff, sContent
    Close #ff
End Sub