# Solved: VBA to xml



## Red2034 (Apr 17, 2007)

I have a sample/example that works, now I just need to be able to format it...
Below is the VBA that works:


```
' This procedure creates XML document
' and saves it to disk.
' Requires msxml.dll (Go to Project --> References and
' and choose Microsoft XML version 2.0, or whatever the
' current version you have installed)
' The example given below will write the following XML
' documents.
'
' <Family>
'    <Member Relationship="Father">
'       <Name>Some Guy</Name>
'    </Member>
' </Family>
'
'but it should be clear how to modify the code
'to create your own documents

Private Sub Create_XML()
   
   Dim objDom As DOMDocument
   Dim objRootElem As IXMLDOMElement
   Dim objMemberElem As IXMLDOMElement
   Dim objMemberRel As IXMLDOMAttribute
   Dim objMemberName As IXMLDOMElement
   
   Set objDom = New DOMDocument
   
   ' Creates root element
   Set objRootElem = objDom.createElement("Family")
   objDom.appendChild objRootElem
   
   ' Creates Member element
   Set objMemberElem = objDom.createElement("Member")
   objRootElem.appendChild objMemberElem
   
   ' Creates Attribute to the Member Element
   Set objMemberRel = objDom.createAttribute("Relationship")
   objMemberRel.NodeValue = "Father"
   objMemberElem.setAttributeNode objMemberRel
   
   ' Create element under Member element, and
   ' gives value "some guy"
   Set objMemberName = objDom.createElement("Name")
   objMemberElem.appendChild objMemberName
   objMemberName.Text = "some guy"

   ' Saves XML data to disk.
   objDom.Save ("c:\temp\XML.xml")
End Sub
```
This is the sample xml I would like it to look like:


```
<?xml version="1.0" encoding="UTF-8"?>
<MENU>		
   <MODULE TITLE=" ">
   <PAGE>
				<NODE graphic="modules/images/010.jpg"><![CDATA[<h1>XML text here</h1> ]]>
					<instru><![CDATA[<i1>More text here</i1>]]></instru>
					<interaction>
						<popup id="1" title="Title">
							<body><![CDATA[<h1>Body text</h1>]]>
							</body>
						</popup>
					</interaction>
				</NODE>
				
				
	</PAGE>	
	</MODULE>
</MENU>
```
Thanks for the suggestions!!!

Red


----------



## Red2034 (Apr 17, 2007)

Any help on this would be greatly appreciated!


----------



## Red2034 (Apr 17, 2007)

good news I have got the node structure working right, but still cant format the xml all 'pretty'....


```
Dim objDom As DOMDocument
   
   Dim objRootElem As IXMLDOMElement
   Dim objModElem As IXMLDOMElement
   Dim objPageName As IXMLDOMElement
   Dim objRootRel As IXMLDOMAttribute
   Dim objModRel As IXMLDOMAttribute
   Dim objPageRel As IXMLDOMAttribute
   
   Set objDom = New DOMDocument
   
   ' MENU
   Set objRootElem = objDom.createElement("MENU")
   Set objRootRel = objDom.createAttribute("TITLE")
   objRootRel.Text = ("Introduction to the eLearn autoSuite v1.4")
   objRootElem.setAttributeNode objRootRel
   objDom.appendChild objRootElem
   objRootElem.InsertBefore objRootElem.createTextNode(vbCrLf), objRootElem.FirstChild


   
   ' MODULE
   Set objModElem = objDom.createElement("MODULE")
   objRootElem.appendChild objModElem
   Set objModRel = objDom.createAttribute("TITLE")
   objModRel.Text = ("eLearn autoSuite v1.4")
   objModElem.setAttributeNode objModRel
   
   ' PAGE
   Set objPageName = objDom.createElement("PAGE")
   objModElem.appendChild objPageName
   Set objPageRel = objDom.createAttribute("ID")
   objPageRel.Text = ("1")
   objPageName.setAttributeNode objPageRel
   Set objPageRel = objDom.createAttribute("TITLE")
   objPageRel.Text = ("Navigating this courseware")
   objPageName.setAttributeNode objPageRel
   Set objPageRel = objDom.createAttribute("FILENAME")
   objPageRel.Text = ("010.jpg")
   objPageName.setAttributeNode objPageRel
   Set objPageRel = objDom.createAttribute("AUDIO")
   objPageRel.Text = ("010.swf")
   objPageName.setAttributeNode objPageRel
   objPageName.Text = ""
   
  

   ' Saves XML data to disk.
   objDom.Save ("c:\temp\XMLLLL.xml")
End Sub
```
I did find some formatting code listed below but havent had a chance to run thru it...


```
' Add formatting to the document.
Private Sub FormatXmlDocument(ByVal xml_doc As DOMDocument)
    FormatXmlNode xml_doc.DocumentElement, 0
End Sub

' Add formatting to this element. Indent it and add a
' carriage return before its children. Then recursively
' format the children with increased indentation.
Private Sub FormatXmlNode(ByVal node As IXMLDOMNode, ByVal _
    indent As Integer)
Dim child As IXMLDOMNode
Dim text_only As Boolean

    ' Do nothing if this is a text node.
    If TypeOf node Is IXMLDOMText Then Exit Sub

    ' See if this node contains only text.
    text_only = True
    If node.HasChildNodes Then
        For Each child In node.ChildNodes
            If Not (TypeOf child Is IXMLDOMText) Then
                text_only = False
                Exit For
            End If
        Next child
    End If

    ' Process child nodes.
    If node.HasChildNodes Then
        ' Add a carriage return before the children.
        If Not text_only Then
            node.InsertBefore _
                node.OwnerDocument.createTextNode(vbCrLf), _
                node.FirstChild
        End If

        ' Format the children.
        For Each child In node.ChildNodes
            FormatXmlNode child, indent + 2
        Next child
    End If

    ' Format this element.
    If indent > 0 Then
        ' Indent before this element.
        node.ParentNode.InsertBefore _
            node.OwnerDocument.createTextNode(Space$(indent)), _
 _
            node

        ' Indent after the last child node.
        If Not text_only Then _
            node.appendChild _
                node.OwnerDocument.createTextNode(Space$(indent))

        ' Add a carriage return after this node.
        If node.NextSibling Is Nothing Then
            node.ParentNode.appendChild _
                node.OwnerDocument.createTextNode(vbCrLf)
        Else
            node.ParentNode.InsertBefore _
                node.OwnerDocument.createTextNode(vbCrLf), _
                node.NextSibling
        End If
    End If
End Sub
```


----------



## Zack Barresse (Jul 25, 2004)

Here ya go (for future posters)...


```
Private Sub Create_XML()

    Dim objDom As DOMDocument
    Dim objRootElem As IXMLDOMElement
    Dim objModElem As IXMLDOMElement
    Dim objPageName As IXMLDOMElement
    Dim objRootRel As IXMLDOMAttribute
    Dim objModRel As IXMLDOMAttribute
    Dim objPageRel As IXMLDOMAttribute

    Set objDom = New DOMDocument

    ' MENU
    Set objRootElem = objDom.createElement("MENU")
    Set objRootRel = objDom.createAttribute("TITLE")
    objRootRel.Text = ("Introduction to the eLearn autoSuite v1.4")
    objRootElem.setAttributeNode objRootRel
    objDom.appendChild objRootElem

    ' MODULE
    Set objModElem = objDom.createElement("MODULE")
    objRootElem.appendChild objModElem
    Set objModRel = objDom.createAttribute("TITLE")
    objModRel.Text = ("eLearn autoSuite v1.4")
    objModElem.setAttributeNode objModRel

    ' PAGE
    Set objPageName = objDom.createElement("PAGE")
    objModElem.appendChild objPageName
    Set objPageRel = objDom.createAttribute("ID")
    objPageRel.Text = ("1")
    objPageName.setAttributeNode objPageRel
    Set objPageRel = objDom.createAttribute("TITLE")
    objPageRel.Text = ("Navigating this courseware")
    objPageName.setAttributeNode objPageRel
    Set objPageRel = objDom.createAttribute("FILENAME")
    objPageRel.Text = ("010.jpg")
    objPageName.setAttributeNode objPageRel
    Set objPageRel = objDom.createAttribute("AUDIO")
    objPageRel.Text = ("010.swf")
    objPageName.setAttributeNode objPageRel
    objPageName.Text = ""
    'Format XML data
    Call FormatXmlDocument(objDom)
    ' Saves XML data to disk.
    objDom.Save ("c:\eLearn\temp\XMLLLL.xml")
End Sub

' Add formatting to the document.
Sub FormatXmlDocument(ByVal xml_doc As DOMDocument)
    FormatXmlNode xml_doc.DocumentElement, 0
End Sub

' Add formatting to this element. Indent it and add a
' carriage return before its children. Then recursively
' format the children with increased indentation.
Sub FormatXmlNode(ByVal node As IXMLDOMNode, ByVal indent As Integer)
    Dim child As IXMLDOMNode
    Dim text_only As Boolean
    ' Do nothing if this is a text node.
    If TypeOf node Is IXMLDOMText Then Exit Sub
    ' See if this node contains only text.
    text_only = True
    If node.HasChildNodes Then
        For Each child In node.childNodes
            If Not (TypeOf child Is IXMLDOMText) Then
                text_only = False
                Exit For
            End If
        Next child
    End If
    ' Process child nodes.
    If node.HasChildNodes Then
        ' Add a carriage return before the children.
        If Not text_only Then
            node.InsertBefore node.OwnerDocument.createTextNode(Chr(10)), node.firstChild
        End If
        ' Format the children.
        For Each child In node.childNodes
            FormatXmlNode child, indent + 2
        Next child
    End If
    ' Format this element.
    If indent > 0 Then
        ' Indent before this element.
        node.ParentNode.InsertBefore node.OwnerDocument.createTextNode(Space$(indent)), node
        ' Indent after the last child node.
        If Not text_only Then node.appendChild node.OwnerDocument.createTextNode(Space$(indent))
        ' Add a carriage return after this node.
        If node.NextSibling Is Nothing Then
            node.ParentNode.appendChild node.OwnerDocument.createTextNode(Chr(10))
        Else
            node.ParentNode.InsertBefore node.OwnerDocument.createTextNode(Chr(10)), node.NextSibling
        End If
    End If
End Sub
```
Works for me in testing.


----------

