Excel表をXML出力

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

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