Sub make_xml() Dim xdoc As New DOMDocument, xtree As IXMLDOMElement Dim PI As IXMLDOMProcessingInstruction Dim LOB As IXMLDOMElement Dim fld As IXMLDOMElement 'xml header Set PI = xdoc.createProcessingInstruction(“xml", “version=’1.0′ encoding=’UTF-8′ standalone=’yes’") Call xdoc.appendChild(PI) 'root tree Set xtree = xdoc.createElement(“all") xtree.Text = vbNewLine Call xdoc.appendChild(xtree) '横軸チェック x = 1 Do While Cells(1, x) <> “": x = x + 1: Loop x = x – 1 y = 2 '縦ループ Do While Cells(y, 1) <> “" '親 Set LOB = xdoc.createElement(“data") '横ループ For i = 1 To x '子1 Set fld = xdoc.createElement(Cells(1, i)) fld.Text = Cells(y, i) Call LOB.appendChild(fld) Call LOB.appendChild(xdoc.createTextNode(vbNewLine)) Next '親書き出し Call xtree.appendChild(LOB) y = y + 1 Loop 'xml保存 xdoc.Save (“c:\temp\swlist.xml") MsgBox “done" End Sub
「XML編」カテゴリーアーカイブ
VBA:XML作成
返信
'MDRを読み込んで新規XMLファイルを作成するVBAプログラム Sub export_xml() Dim xdoc As New DOMDocument, xtree As IXMLDOMElement Dim PI As IXMLDOMProcessingInstruction Dim LOB As IXMLDOMElement, FAM As IXMLDOMElement Dim BRAND As IXMLDOMElement Dim RS As Recordset 'xml header Set PI = xdoc.createProcessingInstruction(“xml", “version='1.0′") Call xdoc.appendChild(PI) 'root tree Set xtree = xdoc.createElement(“PRODUCT") Call xdoc.appendChild(xtree) 'get data from database Set RS = CurrentDb.OpenRecordset(“select * from xxxx") Do While Not RS.EOF '親 Set LOB = xdoc.createElement(“LOB") Call LOB.setAttribute(“NAME", RS!PRODUCT) '子1 Set FAM = xdoc.createElement(“FAMILY") FAM.Text = RS!FAMILY Call FAM.setAttribute(“CODE", RS!FAMILY_ID) Call LOB.appendChild(FAM) '子2 Set BRAND = xdoc.createElement(“BRAND") BRAND.Text = RS!BRAND Call BRAND.setAttribute(“CODE", RS!BRAND_CD) Call LOB.appendChild(BRAND) '親書き出し Call xtree.appendChild(LOB) 'next record RS.MoveNext Loop 'db close RS.Close 'xml保存 xdoc.Save (“c:\temp\test.xml") End Sub