VBAマクロを使用してExcelデータの各行をxmlファイルに作成

Question

Excelデータの各行（特定の列）をVBAマクロを使用してXMLファイル（タグ付き）に作成しようとしています。私はファイルを作成することができますが、データはXMLファイルに取り込まれません。私を助けてください！！

Option Explicit 

Private Sub SaveAs_XML() 
On Error GoTo ErrHandle  
    Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60 
    Dim root As IXMLDOMElement, dataNode As IXMLDOMElement, lastnameNode As IXMLDOMElement, AgeNode As IXMLDOMElement 
    Dim dataNameAttrib As IXMLDOMAttribute, Attrib As IXMLDOMAttribute 
    Dim nameAttrib As IXMLDOMAttribute, lastnameAttrib As IXMLDOMAttribute, AgeAttrib As IXMLDOMAttribute 
    Dim i As Long 
    Dim Folder As String 
    Dim WS_Src As Worksheet, rng As Range, C As Range, d As Range 
    Dim fs, f, ts, s 
    Dim XDoc 

    Folder = "\C:\New folder\" 
    Set WS_Src = ThisWorkbook.Worksheets("data") 
    Set rng = WS_Src.Range("B1", WS_Src.Range("B" & Rows.Count).End(xlUp)) 
    For Each C In rng 
     Set fs = CreateObject("Scripting.FileSystemObject") 
     fs.CreateTextFile Folder & C.Value & ".xml" 
     Set f = fs.GetFile(Folder & C.Value & ".xml") 
    Next 

    Set XDoc = CreateObject("MSXML2.DOMDocument") 
    ' DECLARE XML DOC OBJECT ' 
    Set root = doc.createElement("list") 
    doc.appendChild root 

    ' WRITE TO XML ' 
    For i = 2 To Sheets(1).UsedRange.Rows.Count 
      ' DATA NODE ' 
      Set dataNode = doc.createElement("data") 
      root.appendChild dataNode 
      ' NAME ATTRIBUTE ' 
      Set dataNameAttrib = doc.createAttribute("name") 
      dataNameAttrib.Value = Range("B" & i) 
      dataNode.setAttributeNode dataNameAttrib 
      ' LASTNAME ATTRIBUTE ' 
      Set lastnameAttrib = doc.createAttribute("lastname") 
      lastnameAttrib.Value = Range("C" & i) 
      lastnameNode.setAttributeNode lastnameAttrib    
      ' AGE ATTRIBUTE ' 
      Set AgeAttrib = doc.createAttribute("age") 
      AgeAttrib.Value = Range("E" & i) 
      AgeNode.setAttributeNode AgeAttrib   

    Next i 

     ' 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 


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

ErrHandle: 
    MsgBox Err.Number & " - " & Err.Description, vbCritical 
    Exit Sub 
End Sub 

私は、これはあなたが必要とする何をすべき

$ Output 

<?xml version="1.0" encoding="UTF-8"?> 
<List> 
    <Data name="test1" 
    lastname="lastname1" 
    age ="24" 
    />   
</List> 

Answer 1

出力は行ごとにこのような何か（xmlファイル）になりたいです。 xslはありませんが、それは問題ではありません。

あなたの質問には、コードセクションが多少離れているようですが、正確に何をしたいのかをいくつか推測しました。

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