2

Hi Struggling with VBA code. I am using Microsoft XML V6.0 dom object:

I need following xml to be created exactly:

<UserAccountDetail Type="Account">
    <AccountName>
        <Name>rkhan@gmail.com</Name>
        <Pwd>kdfslj</Pwd>
        <Status>N</Status>
        <ClientId>kdjslj</ClientId>
        <ClientSecret>dkfjsl</ClientSecret>
    </AccountName>
</UserAccountDetail>

Here is my Code so far:

' Create a processing instruction targeted for xml.
    Set node = dom.createProcessingInstruction("xml", "version='1.0'")
    dom.appendChild node
    Set node = Nothing
    
    ' Create a comment for the document.
    Set node = dom.createComment("sample xml file created using XML DOM object.")
    dom.appendChild node
    Set node = Nothing
    
    ' Create the root element.
    
    Set root = dom.createElement("AccountName")
    ' Create a "created" attribute for the root element and
    ' assign the "using dom" character data as the attribute value.
    Set attr = dom.createAttribute("Type")
    attr.Value = "Account"
    root.setAttributeNode attr
    Set attr = Nothing
    
    ' Add the root element to the DOM instance.
    dom.appendChild root
    ' Add a newline plus tab.
    root.appendChild dom.createTextNode(vbNewLine + vbTab)
    ' Create a text element Account Name.
    Set node = dom.createElement("Name")
    node.Text = Trim(UserName)
    ' Add text node to the root element.
    dom.getElementsByTagName("AccountName")(0).appendChild node
    Set node = Nothing
    
    ' Create a text element Password.
    'root(0).appendChild dom.createTextNode(vbNewLine + vbTab)
    Set node = dom.createElement("Pwd")
    node.Text = Trim(UserPwd)
    ' Add text node to the root element.
    dom.getElementsByTagName("AccountName")(0).appendChild node
    node.appendChild dom.createTextNode(vbNewLine + vbTab)
    Set node = Nothing
    
    ' Create a text element Status.
    'root(0).appendChild dom.createTextNode(vbNewLine + vbTab)
    Set node = dom.createElement("Status")
    node.Text = Trim(Status)
    ' Add text node to the root element.
    dom.getElementsByTagName("AccountName")(0).appendChild node
    node.appendChild dom.createTextNode(vbNewLine + vbTab)
    Set node = Nothing
    
    ' Create a text element Client Id.
    'root(0).appendChild dom.createTextNode(vbNewLine + vbTab)
    Set node = dom.createElement("ClientId")
    node.Text = Trim(strClientId)
    ' Add text node to the root element.
    dom.getElementsByTagName("AccountName")(0).appendChild node
    node.appendChild dom.createTextNode(vbNewLine + vbTab)
    Set node = Nothing
    
    ' Create a text element Client Secret.
    'root(0).appendChild dom.createTextNode(vbNewLine + vbTab)
    Set node = dom.createElement("ClientSecret")
    node.Text = Trim(strClientSecret)
    ' Add text node to the root element.
    dom.getElementsByTagName("AccountName")(0).appendChild node
    node.appendChild dom.createTextNode(vbNewLine + vbTab)
    Set node = Nothing
Ike
  • 9,580
  • 4
  • 13
  • 29
Rashid Khan
  • 69
  • 1
  • 1
  • 7
  • Just look at this one: http://stackoverflow.com/questions/1118576/how-can-i-pretty-print-xml-source-using-vb6-and-msxml – bart-pieter Oct 06 '16 at 12:50

1 Answers1

4

Using VBA's MSXML object to create an XML document will not automatically pretty print output with indentation. To resolve, run an identity transform XSLT just after creating and processing your dom object with child elements. Fortunately, MSXML can run XSLT 1.0 scripts:

Dim xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60

'...same code to build XML document...'

' PRETTY PRINT RAW OUTPUT '
xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
        & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
        & "                xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
        & "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
        & "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
        & "            encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
        & " <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _
        & "  <xsl:copy>" _
        & "   <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _
        & "  </xsl:copy>" _
        & " </xsl:template>" _
        & "</xsl:stylesheet>"

xslDoc.async = False     
dom.transformNodeToObject xslDoc, newDoc
newDoc.Save ActiveWorkbook.Path & "\Output.xml"
Parfait
  • 104,375
  • 17
  • 94
  • 125