【VBA】ノード名を指定せずにXMLをパースする

CSVはExcelと相性が良いからか、CSVをExcelに取り込むというのはかなり情報が見つかります。

一方でVBAからXMLをパースしてExcelに取り込むというのも割とよくありそうなんですが、結構情報が少ないです。

また情報が見つかっても、ノード名をハードコーディングしている物が多いです。

取り込むXMLの形式なんて決まっていることが大半なんで当たり前か。

ただ、個人的にはレイアウト不明なXMLをVBAでパースして、内容だけ見やすくしたいということがあるので、コードを考えてみました。

MSXML2.DOMDocumentを使用してXMLをパース

テストに使用するXMLは以下です。

<?xml version="1.0" encoding="UTF-8" ?>
<fruits>
  <item>
    <name>みかん</name>
    <color>オレンジ</color>
    <value>10</value>
  </item>
  <item>
    <name>ぶどう</name>
    <color>紫</color>
    <value>20</value>
  </item>
</fruits>

上記をパースしてExcelシート上に書き出しを行います。

パースをするには、VBAからMSXML2.DOMDocumentを呼び出して利用することにします。

    'XMLをロードする
    Set XMLDoc = CreateObject("MSXML2.DOMDocument.6.0")
    XMLDoc.Load ("C:\test.xml")

これでUTF-8もSIJSも両方読めるようなので超便利ですね。

ちなみに、CreateObject(“MSXML2.DOMDocument”)となっている情報があって、これだと動かなかったためCreateObject(“MSXML2.DOMDocument.6.0”)にしました。

これで時間を滅茶苦茶無駄にした…。

どうやらWindows8やWIndows10では6.0をつけないといけないようですね。

子ノードを再帰呼び出ししてExcelシートに書き出す

作ったソースが以下のとおりです。

Private sh As Object
Private row As Long
Private col As Integer

Public Sub main()
    Dim path As String
    Dim XMLDoc As Object
    
    'ファイル選択ダイアログでパスを指定
    path = getFilePath(ThisWorkbook.path)
    If path = "" Then Exit Sub
    
    'XMLをロードする
    Set XMLDoc = CreateObject("MSXML2.DOMDocument.6.0")
    XMLDoc.Load (path)
    If (XMLDoc.parseError.ErrorCode <> 0) Then
        'ロード失敗時
        MsgBox XMLDoc.parseError.reason, vbCritical
        GoTo endProc
    End If
    
    '出力シートを定義
    Set sh = ThisWorkbook.Worksheets("Sheet1") 'Sheet1に出力
    sh.Cells.Clear
    row = 1
    
    '子ノードを書き出す
    Call getchildren(XMLDoc)
    
'後処理(開放)
endProc:
    Set sh = Nothing
    Set XMLDoc = Nothing

End Sub

'ファイル選択ダイアログでパスを指定
Private Function getFilePath(default As String)
    Dim path As Variant
    
    ChDir default
    path = Application.GetOpenFilename("XMLファイル(*.xml),*.xml")

    If VarType(path) = vbBoolean Then
        getFilePath = ""
    Else
        getFilePath = path
    End If
End Function

'子ノードを書き出す
Private Sub getchildren(XMLParent As Variant)
    For Each XMLChilld In XMLParent.ChildNodes
        If XMLChilld.ChildNodes.Length = 0 Then
            If Not XMLParent.BaseName = "" Then
                sh.Cells(row, col).Value = XMLParent.BaseName
                col = col + 1
                sh.Cells(row, col).Value = XMLChilld.Text
            End If
        Else
            Call getchildren(XMLChilld)
        End If
    Next
    If col <> 1 Then
        row = row + 1
        col = 1
    End If
End Sub

実行結果

ChildNodesで子ノードの一覧を取得して、それをループさせています。

そして子ノードのChildNodes.Lengthが1以上なら孫ノードもあるはずなので、関数を再帰呼び出しして下の階層を見に行くようにしています。

ChildNodes.Lengthが0なら最下層なので、Excelシートに値を書き込みます。


課題

「XMLをパースしたんだから、階層で表示しろよ」と言われればそのとおりなのです。

ただ今回「レイアウト不明なXMLをExcelで見やすく表示する」ということがやりたかったので、NameとValueのペアで書き出しを行うのは必須でした。

階層で表示したい場合、同じ階層のものは同じ行に表示するのが良いかと思いますが、NameとValueのペアを保ったまま、表示する良い方法が思いつきませんでした。

Jsonをパースした時とかもそうなのですが、Excelは2次元しか無いので、階層が深くなると見やすく表示するのがお手上げなんですよねえ。


コメントを残す

メールアドレスが公開されることはありません。

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)