Skip to main content
added 19 characters in body
Source Link
Tim Williams
  • 169k
  • 8
  • 104
  • 143

This should do what you need. No xsl, but that doesn't matter.

Your question seems to have code sections which are somewhat disconnected from each other, so I made a few guesses about what exactly you're wanting to do.

Private Sub SaveAs_XML()

    Dim doc As MSXML2.DOMDocument60, pi
    Dim root As IXMLDOMElement, dataNode As IXMLDOMElement
    Dim i As Long
    
    For i = 2 To Sheets(1).UsedRange.Rows.Count
            
        Set doc = New MSXML2.DOMDocument60
        
        Set root = doc.createElement("list")
        doc.appendChild root
            
        Set dataNode = doc.createElement("data")
        root.appendChild dataNode
        
        AddAttributeWithValue dataNode, "name", Range("B" & i)
        AddAttributeWithValue dataNode, "lastname", Range("C" & i)
        AddAttributeWithValue dataNode, "age", Range("E" & i)
        
        Set pi = doc.createProcessingInstruction("xml", "version=""1.0""")
        doc.InsertBefore pi, doc.ChildNodes.Item(0)
        
        doc.Save "C:\_Stuff\xml\" & Range("B" & i).Value & ".xml"
    Next i

    MsgBox "Successfully exported Excel data to XML!", vbInformation

End Sub

'utility: add an attribute (with a value) to an element
Sub AddAttributeWithValue(el As IXMLDOMElement, attName, attValue)
    Dim att
    Set att = el.OwnerDocument.createAttribute(attName)
    att.Value = attValue
    el.setAttributeNode att
End Sub

This should do what you need. No xsl, but that doesn't matter.

Your question seems to have code sections which are somewhat disconnected from each other, so I made a few guesses about what exactly you're wanting to do.

Private Sub SaveAs_XML()

    Dim doc As MSXML2.DOMDocument60, pi
    Dim root As IXMLDOMElement, dataNode As IXMLDOMElement
    Dim i As Long
    
    For i = 2 To Sheets(1).UsedRange.Rows.Count
            
        Set doc = New MSXML2.DOMDocument60
        
        Set root = doc.createElement("list")
        doc.appendChild root
            
        Set dataNode = doc.createElement("data")
        root.appendChild dataNode
        
        AddAttributeWithValue dataNode, "name", Range("B" & i)
        AddAttributeWithValue dataNode, "lastname", Range("C" & i)
        AddAttributeWithValue dataNode, "age", Range("E" & i)
        
        Set pi = doc.createProcessingInstruction("xml", "version=""1.0""")
        doc.InsertBefore pi, doc.ChildNodes.Item(0)
        
        doc.Save "C:\_Stuff\xml\" & i & ".xml"
    Next i

    MsgBox "Successfully exported Excel data to XML!", vbInformation

End Sub

'utility: add an attribute (with a value) to an element
Sub AddAttributeWithValue(el As IXMLDOMElement, attName, attValue)
    Dim att
    Set att = el.OwnerDocument.createAttribute(attName)
    att.Value = attValue
    el.setAttributeNode att
End Sub

This should do what you need. No xsl, but that doesn't matter.

Your question seems to have code sections which are somewhat disconnected from each other, so I made a few guesses about what exactly you're wanting to do.

Private Sub SaveAs_XML()

    Dim doc As MSXML2.DOMDocument60, pi
    Dim root As IXMLDOMElement, dataNode As IXMLDOMElement
    Dim i As Long
    
    For i = 2 To Sheets(1).UsedRange.Rows.Count
            
        Set doc = New MSXML2.DOMDocument60
        
        Set root = doc.createElement("list")
        doc.appendChild root
            
        Set dataNode = doc.createElement("data")
        root.appendChild dataNode
        
        AddAttributeWithValue dataNode, "name", Range("B" & i)
        AddAttributeWithValue dataNode, "lastname", Range("C" & i)
        AddAttributeWithValue dataNode, "age", Range("E" & i)
        
        Set pi = doc.createProcessingInstruction("xml", "version=""1.0""")
        doc.InsertBefore pi, doc.ChildNodes.Item(0)
        
        doc.Save "C:\_Stuff\xml\" & Range("B" & i).Value & ".xml"
    Next i

    MsgBox "Successfully exported Excel data to XML!", vbInformation

End Sub

'utility: add an attribute (with a value) to an element
Sub AddAttributeWithValue(el As IXMLDOMElement, attName, attValue)
    Dim att
    Set att = el.OwnerDocument.createAttribute(attName)
    att.Value = attValue
    el.setAttributeNode att
End Sub
Source Link
Tim Williams
  • 169k
  • 8
  • 104
  • 143

This should do what you need. No xsl, but that doesn't matter.

Your question seems to have code sections which are somewhat disconnected from each other, so I made a few guesses about what exactly you're wanting to do.

Private Sub SaveAs_XML()

    Dim doc As MSXML2.DOMDocument60, pi
    Dim root As IXMLDOMElement, dataNode As IXMLDOMElement
    Dim i As Long
    
    For i = 2 To Sheets(1).UsedRange.Rows.Count
            
        Set doc = New MSXML2.DOMDocument60
        
        Set root = doc.createElement("list")
        doc.appendChild root
            
        Set dataNode = doc.createElement("data")
        root.appendChild dataNode
        
        AddAttributeWithValue dataNode, "name", Range("B" & i)
        AddAttributeWithValue dataNode, "lastname", Range("C" & i)
        AddAttributeWithValue dataNode, "age", Range("E" & i)
        
        Set pi = doc.createProcessingInstruction("xml", "version=""1.0""")
        doc.InsertBefore pi, doc.ChildNodes.Item(0)
        
        doc.Save "C:\_Stuff\xml\" & i & ".xml"
    Next i

    MsgBox "Successfully exported Excel data to XML!", vbInformation

End Sub

'utility: add an attribute (with a value) to an element
Sub AddAttributeWithValue(el As IXMLDOMElement, attName, attValue)
    Dim att
    Set att = el.OwnerDocument.createAttribute(attName)
    att.Value = attValue
    el.setAttributeNode att
End Sub