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