ExcelのVBAで、XMLファイルのデータ抽出

質問

はじめまして。

XMLファイルに含まれたデータの中から、特定の条件のデータのみを抽出するプログラムを作りたいと思っております。

XMLファイルの中身は
<p name="test">あいうえお</p>
<p name="test2">かきくけこ</p>
<p name="test3">さしすせそ</p>
…

のようなデータが2～300以上あり、その中から、NAMEが"test"のものだけを抽出するプログラムなのですが、ExcelのVBAで可能でしょうか？
ご教授頂ければ幸いです。よろしくお願いいたします。

回答No.1

queuerev2

XMLの書かれたテキストファイルからExcelのワークシートに抽出するものとして作ってみました。
ExcelのAdvancedFilter（フィルタオプションの設定）を使ったものとVBAのLike演算子で１行ずつ判定するものの２種類です。
プロシージャは標準モジュールに置いてください。
XMLの書かれたテキストファイルは仮に"C:\XmlFile.xml"としましたので質問者様の実情に合わせて書き換えるようお願いいたします。
ご質問やご希望にあわないところなどありましたら補足いただければ、と思います。

１．AdvancedFilter使用
マクロのあるブックに"抽出"と"条件"の２枚のシートを用意し、
"条件"は、A1を空文字列以外の何らかの文字列、
A2をマッチングパターン（たとえば「'=<p name="test">*」）としておく。

Sub XMLextract1()
Workbooks.OpenText "C:\XmlFile.xml" 'XMLファイル
Selection.EntireRow.Insert
Selection.Value = ThisWorkbook.Worksheets("条件").Range("A1").Value
ThisWorkbook.Worksheets("抽出").Range("A:A").ClearContents
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:= _
ThisWorkbook.Worksheets("条件").Range("A1:A2"), _
CopyToRange:=ThisWorkbook.Worksheets("抽出").Range("A1")
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Worksheets("抽出").Activate
Range("1:1").Delete
End Sub

２．Like演算子使用
マクロのあるブックにシート"抽出"を用意しておく。

Sub XMLextract2()
Dim FSO, XmlFile, MatchPattern, ExTop, ExRow, Line1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set XmlFile = FSO.OpenTextFile("C:\XmlFile.xml") 'XMLファイル
Set ExTop = ThisWorkbook.Worksheets("抽出").Range("A1")
ExRow = 1
MatchPattern = "<p name=""test"">*" 'マッチングパターンをここに設定
ExTop.EntireColumn.ClearContents
Application.ScreenUpdating = False
Do While XmlFile.AtEndOfLine = False
Line1 = XmlFile.ReadLine
If Line1 Like MatchPattern Then
ExTop.Cells(ExRow, 1).Value = Line1
ExRow = ExRow + 1
End If
Loop
Application.ScreenUpdating = True
End Sub