XMLをエクセルに取り込むマクロ

XMLをエクセルで取り込み、表にしたいと考えています。
エクセル2003にて下記のtest.xmlをインポートすると

<?xml version="1.0" encoding="UTF-8" ?>
<McXMLRoot>
<McXMLData>
<McXMLPageData>
<ヘッダ情報>
<作成日>
<value>平成21年 5月28日</value>
</作成日>
<作成時間>
<value>10時55分12秒</value>
</作成時間>
<ページ数>
<value>0001</value>
</ページ数>
</ヘッダ情報>
<明細情報>
<商品名>
<value>パソコン</value>
</商品名>
<価格>
<value>100000</value>
</価格>
</明細情報>
<明細情報>
<商品名>
<value>プリンタ</value>
</商品名>
<価格>
<value>20000</value>
</価格>
</明細情報>
</McXMLPageData>
</McXMLData>
</McXMLRoot>

エクセルでタイトルがvalue,value2…,value5 のように表示されます。
作成日,作成時間,ページ数,商品名,価格
のように表示するためのマクロを作成しようとしているのですが、

Public Const XmlPass = "D:\WORK\test.xml"
Public Sub Auto_Open()
ActiveWorkbook.XmlImport URL:=XmlPass _
, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")
End Sub

で取り込んだあと、どのように処理すればよいのでしょうか？
(1)テキストとして読み込む
(2)<value>のすぐ前にあるタイトル部分を検索
(3)タイトル部分を切り出す。
(4)指定のセルにタイトルをセット

とすると、切り出したタイトルの文字コードがUTF-8のため
文字化けしてしまいます。

Private Sub setTitle()
Dim FileNoRead%
Dim wkFree$
Dim result1 As Integer
Dim result2 As Integer
Dim result3 As Integer
Dim Title(300) As String
Dim Soeji As Integer
Dim Kaishi As Integer
Dim SWork As String

Soeji = 0
Kaishi = 1

FileNoRead% = FreeFile
' テキストのオープン
Open XmlPass For Input Access Read As #FileNoRead%

' テキストの読込
Line Input #FileNoRead%, wkFree$ 'ファイルから１行読み込む

' テキストのクローズ
Close #FileNoRead%

Do While True
Soeji = Soeji + 1
result1 = InStr(Kaishi, wkFree$, "<value>") '<value>出現位置
result2 = InStrRev(wkFree$, ">", result1) + 1 'タイトル終了位置
result3 = InStrRev(wkFree$, "<", result2) + 1 'タイトル開始位置
SWork = Mid(wkFree$, result3, (result1 - result2))

Title(Soeji) = SWork
Kaishi = InStr(result1, wkFree$, "</value>") '</value>出現位置
Kaishi = Kaishi + 8
Loop

End Sub


ほかに何かよい方法があったら教えてください。

P.S)作りはじめのため、バグ多数存在します。

No.4 ベストアンサー 回答者： yyr446 回答日時： 2009/06/02 13:46

「このとき<明細情報>はセットできますが、<ヘッダ情報>はどのようにセットするのでしょうか？」

No2です。<ヘッダ情報>がセットされないのは、
Set nlist = ObjXml.selectNodes("//明細情報/*")
で、<明細情報>以下の要素しかnlistに入れてないからです。
<ヘッダ情報>以下をnlistにセットするなら、
Set nlist = ObjXml.selectNodes("//ヘッダ情報/*")
としてXpathで選ぶか、又はルートからたどって
Set nlist = ObjXml.childNodes(1).childNodes(0).childNodes(0).childNodes(0).childNodes
として選ぶか、又はTagName指定で
Set nlist = ObjXml.getElementsByTagName("ヘッダ情報")
Set nlist = nlist(0).childNodes
と選びます。選んだ上で、
For Each node In nlist
msgbox node.nodeName & _
node.childNodes(0).childNodes(0).nodeValue
Next node
として、項目名と内容を取得できます。
「文字コードは勝手に変換してくれてます（本当かな？）」
ヘッダーの項目の数は nlist.Length になります。

この回答へのお礼

ありがとうございました。
勉強になりました。

改良したプログラムで何とかなりました。
ただ、また新たな問題が…

その内容は"XMLをエクセルに取り込むマクロその２"
として新たに投稿したのでよろしければ教えてください

お礼日時：2009/06/03 16:58

No.3 回答者： mitarashi 回答日時： 2009/05/29 23:51

>文字コードがUTF-8のため文字化けしてしまいます。

の部分限定だと、ADODB.Streamを介して、UTF-8→Shift JIS等に変換できます。検索していただくとVBAのコードも沢山見つかりますが、一例です。
http://oshiete1.goo.ne.jp/qa1963113.html

No.2 回答者： yyr446 回答日時： 2009/05/29 18:08

もうちょっと丁寧に、ちゃんと動くように書き直しました。

Public Const XmlPass = "D:\WORK\test.xml"
Sub parseXML()
Dim ObjXml As MSXML2.DOMDocument
Set ObjXml = CreateObject("MSXML2.DOMDocument")
If ObjXml.Load(XmlPass) = False Then
Exit Sub
End If
Dim nlist As MSXML2.IXMLDOMNodeList
Dim h_nlist As MSXML2.IXMLDOMNodeList
Set nlist = ObjXml.selectNodes("//明細情報/*")
Dim node As MSXML2.IXMLDOMNode
Dim i As Integer
i = 2
For Each node In nlist
Set h_nlist = ObjXml.getElementsByTagName("作成日")
Cells(i, 1).Value = h_nlist(0).childNodes(0).childNodes(0).nodeValue
Set h_nlist = ObjXml.getElementsByTagName("作成時間")
Cells(i, 2).Value = h_nlist(0).childNodes(0).childNodes(0).nodeValue
Set h_nlist = ObjXml.getElementsByTagName("ページ数")
Cells(i, 3).Value = h_nlist(0).childNodes(0).childNodes(0).nodeValue
If node.nodeName = "商品名" Then
Cells(i, 4).Value = node.childNodes(0).childNodes(0).nodeValue
End If
If node.nodeName = "価格" Then
Cells(i, 5).Value = node.childNodes(0).childNodes(0).nodeValue
i = i + 1
End If
Next node
End Sub

この回答へのお礼

回答ありがとうございました。
ただ、申し訳ありませんが大事なことを伝えておりませんでした。

取り込むべきXMLの種類は多数あり、タイトルが作成日,作成時間,ページ数,商品名,価格
とは限らないのです。

なのでやはりXMLをインポート後にタイトルセットでないとダメのようです。
そこで以下を考えました。
↓
Private Sub parseXML()
Dim ObjXml As MSXML2.DOMDocument
Set ObjXml = CreateObject("MSXML2.DOMDocument")
If ObjXml.Load(XmlPass) = False Then
Exit Sub
End If
Dim nlist As MSXML2.IXMLDOMNodeList
Dim h_nlist As MSXML2.IXMLDOMNodeList
Set nlist = ObjXml.selectNodes("//明細情報/*")
Dim node As MSXML2.IXMLDOMNode
Dim strWork As String
Dim i As Integer
i = 1
For Each node In nlist
If i = 1 Then '最初のタイトルを退避
strWork = node.nodeName
MsgBox ("最初のタイトル[" & strWork & "]")
Else
MsgBox ("node.nodeName[" & node.nodeName & "]")
If strWork = node.nodeName Then
Exit For
End If
End If
' タイトルセット
Cells(1, i).Value = node.nodeName

i = i + 1
Next node
End Sub

このとき<明細情報>はセットできますが、<ヘッダ情報>はどのようにセットするのでしょうか？
Cells(1, i).Value = ？？？ を教えてください。
よろしくお願いします。

お礼日時：2009/06/01 11:09

No.1 回答者： yyr446 回答日時： 2009/05/29 17:01

XMLをシートにインポートせずに、マクロVBAでXMLと処理した方が簡単です。

(読み込み元のXML構造が分からないので以下のコードは想像です)
まず、VBEの参照設定で「Microsoft XML v6.0」をチェックします。
Public Const XmlPass = "D:\WORK\test.xml"
sub parseXML()
'XMLのDOMオブジェクトを準備します。
Dim ObjXml As MSXML2.DOMDocument
Set ObjXml = CreateObject("MSXML2.DOMDocument")
'XMLファイルをオブジェクトにロードします。
if(ObjXml.Load(XmlPass)　= false ) Then Exit sub
Dim nlist As MSXML2.IXMLDOMNodeList
'ノードリストオブジェクトも準備します。
Set nlist = ObjXml.selectNodes("//明細情報/*")
'Xpathで取得するノードを選びます。
Dim node As MSXML2.IXMLDOMNode
'ノードオブジェクトを準備します
dim i as Integer
i=2
For Each node In nlist
'以下のループで中身を取り出します。
if node.childNodes(0).nodeName = "商品名" then _
cells(i,4).value = node.childNodes(0).childNodes(0).childNodes(0).value
end if
if node.childNodes(0).nodeName = "価格" then _
cells(i,5).value = node.childNodes(0).childNodes(0).childNodes(0).value
end if
i = i + 1
Next node

End Sub

この回答へのお礼

大変申し訳ありません。
大事な部分をお伝えしていませんでした。
回答番号2のお礼を参照し、ご回答いただけないでしょうか？
よろしくお願いします。

お礼日時：2009/06/01 11:13