README.md

XmlHttpConnect

HTTP経由でXMLデータを読み込んでExcelシートに表示します。 XMLといってもHTMLのtable#data-root``tr``tdの2次元構成が想定されています。

• VBA XMLデータをDOMで扱う方法 - SMILEJAPAN プログラミングメモ

sampledata.xml

<table id="data-root">
	<tr>
		<td>id</td>
		<td>name</td>
		<td>hex</td>
		<td>red</td>
		<td>green</td>
		<td>blue</td>
	</tr>
	<tr>
		<td>1</td>
		<td>aliceblue</td>
		<td>#f0f8ff</td>
		<td>240</td>
		<td>248</td>
		<td>255</td>
	</tr>
	<tr>
		<td>2</td>
		<td>antiquewhite</td>
		<td>#faebd7</td>
		<td>250</td>
		<td>235</td>
		<td>215</td>
	</tr>
	<tr>
		<td>3</td>
		<td>aqua</td>
		<td>#00ffff</td>
		<td>0</td>
		<td>255</td>
		<td>255</td>
	</tr>
	<tr>
		<td>4</td>
		<td>aquamarine</td>
		<td>#7fffd4</td>
		<td>127</td>
		<td>255</td>
		<td>212</td>
	</tr>
	<tr>
		<td>5</td>
		<td>azure</td>
		<td>#f0ffff</td>
		<td>240</td>
		<td>255</td>
		<td>255</td>
	</tr>
	<tr>
		<td>6</td>
		<td>beige</td>
		<td>#f5f5dc</td>
		<td>245</td>
		<td>245</td>
		<td>220</td>
	</tr>
	<tr>
		<td>7</td>
		<td>bisque</td>
		<td>#ffe4c4</td>
		<td>255</td>
		<td>228</td>
		<td>196</td>
	</tr>
	<tr>
		<td>8</td>
		<td>black</td>
		<td>#000000</td>
		<td>0</td>
		<td>0</td>
		<td>0</td>
	</tr>
	<tr>
		<td>9</td>
		<td>blanchedalmond</td>
		<td>#ffebcd</td>
		<td>255</td>
		<td>235</td>
		<td>205</td>
	</tr>
	<tr>
		<td>10</td>
		<td>blue</td>
		<td>#0000ff</td>
		<td>0</td>
		<td>0</td>
		<td>255</td>
	</tr>
</table>

SampleModule.bas

Attribute VB_Name = "SampleModule"
Option Explicit

Sub test()
    Dim xdoc As MSXML2.DOMDocument
    Set xdoc = GetXmlDomDocument("http://localhost:4567/sampledata.xml")
    Dim xNode As MSXML2.IXMLDOMNode
    Set xNode = xdoc.SelectSingleNode("//*[@id='data-root']")
    DrawData xNode
End Sub

Sub DrawData(ByRef xNode As MSXML2.IXMLDOMNode)
    Dim StartCell As String
    StartCell = "A1"
    Dim RowCnt, cl, i, j As Long
    RowCnt = xNode.ChildNodes.Length
    Dim row, cols, col As Object
    Dim rng As Variant
    rng = Range(StartCell).Resize(RowCnt, 100)
    i = 1
    For Each row In xNode.ChildNodes
        Set cols = row.ChildNodes
        j = 1
        For Each col In cols
            rng(i, j) = col.Text
            j = j + 1
        Next col
        i = i + 1
    Next row
    Range(StartCell).Resize(RowCnt, 100) = rng
End Sub

XmlHttpConnect.bas

Attribute VB_Name = "XmlHttpConnect"
Option Explicit

Public Function GetXmlDomDocument(ByVal url As String) As MSXML2.DOMDocument

    'http://msdn.microsoft.com/ja-jp/library/aa468547.aspx
    'XMLドキュメントを読み込むには、まず最初にDOMDocumentクラスのインスタンスを作成する
    Dim xdoc As MSXML2.DOMDocument
    Set xdoc = New MSXML2.DOMDocument
    
    'ドキュメントのAsyncプロパティをFalseに設定すると、ドキュメントが完全に読み込まれて
    '処理の準備が整うまで、パーサーはコードにコントロールを返しません。
    xdoc.async = False
    
    'エラー対策 http://support.microsoft.com/kb/281142/ja
    xdoc.setProperty "ServerHTTPRequest", True
 
    'MSXMLパーサーを使用すると、URLを介してXMLドキュメントを読み込むことができます。
    'ドキュメントを読み込むには､Loadメソッドを使用
    If xdoc.Load(url) Then
        Set GetXmlDomDocument = xdoc
    Else
        Dim strErrText As String
        Dim xPE As MSXML2.IXMLDOMParseError
        Set xPE = xdoc.parseError
        With xPE
            strErrText = "XMLドキュメントの読み込みに失敗しました :" & _
                "次のエラーが原因です :" & vbCrLf & _
                "エラー番号 # : " & .ErrorCode & vbCrLf & _
                "エラー原因 # : " & xPE.reason & vbCrLf & _
                "行 # : " & .Line & vbCrLf & _
                "行位置 : " & .linepos & vbCrLf & _
                "ファイル内の位置 : " & .filepos & vbCrLf & _
                "ソーステキスト : " & .srcText & vbCrLf & _
                "ドキュメントURL : " & .url
        End With
        MsgBox strErrText, vbExclamation
    End If
    
    'ドキュメントでの作業が終了したら、きちんとオブジェクト参照を解放する必要があります。
    'MSXML パーサーでは、明示的な Close メソッドは公開されていません。
    'このため、参照先を Nothing に設定します。
    Set xdoc = Nothing

End Function