各固有の要素の下に繰り返しタグとしてExcelからXMLを生成

Question

各ユニークなデータ要素の下に反復する属性タグのためにExcelからXMLファイルを生成する必要があります。 以下はExcel形式です。 Data要素の一意性は、XMLファイルには表示されないID列によって識別されます。

Excelのフォーマット：（入力）

ID | Name | Description | AttributeName | AttributeValue 
-------------------------------------------------------- 
01 | A | Test1  | Width   | 33 
    |  |    | Height  | 50 
    |  |    | Length  | 25 
02 | B | Test2  | Width   | 55 
    |  |    | Depth   | 88 

XMLフォーマット：（予想される出力）

<Data name="A" description="Test1"> 
    <Attribute Name="Width" Value="33"/> 
    <Attribute Name="Heigth" Value="50"/> 
    <Attribute Name="Length" Value="25"/> 
</Data> 

<Data name="B" description="Test2"> 
    <Attribute Name="Width" Value="55"/> 
    <Attribute Name="Depth" Value="88"/> 
</Data> 

</List> 

これは私がコードにしようとしているものです。

VBAコード：

Sub GenerateXML_Test() 
Dim myFile As String 

'Create XML File 
    myFile = ThisWorkbook.Path + "\TestXML.xml" 
    Open myFile For Output As #1 

'Get Last Row 
    LastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row 


    Print #1, "<List>" & vbNewLine 

'Print recurring text in xml file 
    For RowIndex = 2 To LastRow 

    Print #1, "<Data name=" & Chr(34) & Cells(RowIndex, 2).Value & Chr(34) & " Description=" & Chr(34) & Cells(RowIndex, 3).Value & Chr(34) & ">" & vbNewLine & "<Attribute Name=" & Chr(34) & Cells(RowIndex, 4).Value & Chr(34) & " Value=" & Chr(34) & Cells(RowIndex, 5).Value & Chr(34) & "/>" & "</Data>" & vbNewLine 

    Next RowIndex 

    Print #1, "</List>" 

    Close #1 

End Sub 

XMLフォーマット：（実際の出力）

<List> 
    <Data name="A" Description="Test1"> 
    <Attribute Name="Width" Value="33" /> 
    </Data> 
    <Data name="" Description=""> 
    <Attribute Name="Height" Value="50" /> 
    </Data> 
    <Data name="" Description=""> 
    <Attribute Name="Length" Value="25" /> 
    </Data> 
    <Data name="B" Description="Test2"> 
    <Attribute Name="Width" Value="55" /> 
    </Data> 
    <Data name="" Description=""> 
    <Attribute Name="Depth" Value="88" /> 
    </Data> 
</List> 

出力Iは、適切なロジックを追加する必要があるとして、期待通りではありません。属性タグは、一意のIDごとに単一のデータ要素で繰り返す必要があります。各データ要素には、任意の数の属性を設定できます。 これを達成するロジックを追加するのを手伝ってください。

Answer 1

VBAにはMSXMLオブジェクトを使用するDOMビルダーが搭載されています。したがって、テキストストリームを使用して、XML文書のExcelで連結文字列を作成する必要はありません。

空の列Aの値に対して条件付きで設定されたノードおよび属性オブジェクトと対話するMSXML v6.0の参照を使用して、次のマクロを検討してください。また、XSLT（identity transform）は（XMLコンテンツは、一の長い行に表示されますそれなしで）かなりXMLを印刷するには、生の出力上で実行されます。

Option Explicit 

Sub xmlExport() 
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, attribNode As IXMLDOMElement 
    Dim dataNameAttrib As IXMLDOMAttribute, descAttrib As IXMLDOMAttribute 
    Dim nameAttrib As IXMLDOMAttribute, valueAttrib As IXMLDOMAttribute 
    Dim i As Long 

    ' DECLARE XML DOC OBJECT ' 
    Set root = doc.createElement("List") 
    doc.appendChild root 

    ' WRITE TO XML ' 
    For i = 2 To Sheets(1).UsedRange.Rows.Count 

     If Len(Trim(Range("A" & i))) <> 0 Then 
      ' 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 

      ' DESCRIPTION ATTRIBUTE ' 
      Set descAttrib = doc.createAttribute("description") 
      descAttrib.Value = Range("C" & i) 
      dataNode.setAttributeNode descAttrib 

      ' ATTRIBUTE NODE ' 
      Set attribNode = doc.createElement("Attribute") 
      dataNode.appendChild attribNode 
      ' NAME ATTRIBUTE ' 
      Set nameAttrib = doc.createAttribute("Name") 
      nameAttrib.Value = Range("D" & i) 
      attribNode.setAttributeNode nameAttrib 
      ' VALUE ATTRIBUTE ' 
      Set valueAttrib = doc.createAttribute("Value") 
      valueAttrib.Value = Range("E" & i) 
      attribNode.setAttributeNode valueAttrib 
     Else 
      ' ATTRIBUTE NODE ' 
      Set attribNode = doc.createElement("Attribute") 
      dataNode.appendChild attribNode 
      ' NAME ATTRIBUTE ' 
      Set nameAttrib = doc.createAttribute("Name") 
      nameAttrib.Value = Range("D" & i) 
      attribNode.setAttributeNode nameAttrib 
      ' VALUE ATTRIBUTE ' 
      Set valueAttrib = doc.createAttribute("Value") 
      valueAttrib.Value = Range("E" & i) 
      attribNode.setAttributeNode valueAttrib 
     End If 

    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 
    doc.transformNodeToObject xslDoc, newDoc 
    newDoc.Save ActiveWorkbook.Path & "\Output.xml" 

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

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

End Sub 

出力

<?xml version="1.0" encoding="UTF-8"?> 
<List> 
    <Data name="A" description="Test1"> 
     <Attribute Name="Width" Value="33"></Attribute> 
     <Attribute Name="Height" Value="50"></Attribute> 
     <Attribute Name="Length" Value="25"></Attribute> 
    </Data> 
    <Data name="B" description="Test2"> 
     <Attribute Name="Width" Value="55"></Attribute> 
     <Attribute Name="Depth" Value="88"></Attribute> 
    </Data> 
</List> 

Answer 2

ネストループを使用する必要があります。このような何か：

Sub GenerateXML_Test() 
    Dim myFile As String 
    Dim i As Integer 
    'Create XML File 
    myFile = ThisWorkbook.Path + "\TestXML.xml" 
    Open myFile For Output As #1 
    'Get Last Row 
    LastRow = ActiveSheet.Cells.Find("*", _ 
     SearchOrder:=xlByRows, _ 
     LookIn:=xlValues, _ 
     SearchDirection:=xlPrevious).Row 
    Print #1, "<List>" & vbNewLine 
    'Print recurring text in xml file 
    For RowIndex = 2 To LastRow 
     Print #1, "<Data name=""" & Cells(RowIndex, 2).Value & _ 
        """ Description=""" & Cells(RowIndex, 3).Value & """>" & _ 
        vbNewLine 
     'Now loop through the attributes until we find another Data element 
     Do While Cells(RowIndex, 2).Value <> "" 
      Print #1, "<Attribute Name=""" & Cells(RowIndex, 4).Value & _ 
         """ Value=""" & Cells(RowIndex, 5).Value & """/>" & _ 
         vbNewLine 
      'btw, incrementing a For variable manually like this is very bad form 
      RowIndex = RowIndex + 1 
      'I would restructure this once you grasp nesting loops. 
     Loop 
     Print #1, "</Data>" & vbNewLine 
    Next RowIndex 
    Print #1, "</List>" 
    Close #1 
End Sub 

また、二重引用符""の代わりに、CHR（34）を使用します。