現在業務でVBを使ってエクセルのマクロを組みたいと思っています。

現在業務でVBを使ってエクセルのマクロを組みたいと思っています。
ただ、全くの初心者で以下の仕様のモノをどんな風にしたら良いか全くわかりません。
ご教授ください。

実施したいこと
・任意のフォルダにある大量のXMLファイルから、指定のタグ内の項目のみ抜き出しエクセルに並べて表示させたい


任意のフォルダ構成としては、
XMLFolder - folder1 - test1.xml
- folder2 - test2.xml
- ・・・・
というようにフォルダの中にさらにフォルダが入っておりその中にxmlファイルが入っております。
なお、xmlファイル以外のファイルが入っているフォルダもあります。

xmlファイル自体はすべて同じの構成です。（タグの名前等は全て一緒）
参考程度に
<?xml version="1.0" encoding="UTF-16LE" ?>
<ID>001</ID>
<ReportID>1</ReportID>
<Version>1</Version>
<TimeFormatSetting>1</TimeFormatSetting>
<IsOfficial>false</IsOfficial>
<SaveAs>ドラフト</SaveAs>
<UpdateDateTime>20090521155628</UpdateDateTime>
<Name>test</Name>
こんなようなxmlファイルが入っています。

例えばこの中のIDとReportIDとUpDateTime内のデータを抜き出してエクセルの列に並べるようなマクロって組めないでしょうか？
全くの無知で大変申し訳ありませんが、どなたかご教授願います。

No.5 ベストアンサー 回答者： mitarashi 回答日時： 2010/01/17 16:19

#4の続きです。

ループ都度MSXMLのオブジェクトを作って、破棄してというのもまずいと考え、クラスモジュールにしてみました。VBEで挿入、クラスモジュールとすると、Class1というのが出来るので、改名してください。試験した際、昔自分で作成したxmlから値が取得できなかったので、調べた結果、namespace一つに対応させたつもりです。（複数の場合どうなのか、理解できておりません）
Private oXMLDom As Object
Private hasNameSpace As Boolean
Private myNameSpace As String

Private Sub Class_Initialize()
Set oXMLDom = CreateObject("MSXML2.DOMDocument")
oXMLDom.async = False
oXMLDom.validateOnParse = False
oXMLDom.resolveExternals = False
End Sub

Function loadFile(strFilePath As String)
loadFile = oXMLDom.Load(strFilePath)
If oXMLDom.namespaces.Length > 0 Then
myNameSpace = "xmlns:myNS='" & oXMLDom.namespaces(0) & "'"
Call oXMLDom.setProperty("SelectionNamespaces", myNameSpace)
hasNameSpace = True
End If
End Function

Function find(myNodeName As String) As Variant
Dim strXpath As String
Dim nodelist As Object
Dim i As Long
Dim buf() As Variant

oXMLDom.setProperty "SelectionLanguage", "XPath"
If hasNameSpace Then
strXpath = "//myNS:" & myNodeName
Else
strXpath = "//" & myNodeName
End If
Set nodelist = oXMLDom.documentElement.selectNodes(strXpath)
If nodelist.Length > 0 Then
ReDim buf(0 To nodelist.Length - 1)
For i = 0 To nodelist.Length - 1
buf(i) = nodelist.Item(i).firstChild.nodeValue
Next i
find = buf()
End If
End Function

Private Sub Class_Terminate()
Set oXMLDom = Nothing
End Sub

この回答へのお礼

ありがとうございます。
また、お礼が遅れて大変申し訳ありませんでした。

正直VBAは全くの初心者のため、コードすら追えないため再度質問してしまうかもしれません。
現在は上記のマクロを始める前に基本中の基本を勉強しているところです。
一度マクロへ挿入して試してみたいと思います。

ありがとうございました。

お礼日時：2010/01/19 10:34

No.4 回答者： mitarashi 回答日時： 2010/01/17 16:10

#3です、自分の勉強のために作りましたので、速くも分かりやすくもなく、解説も致しませんが、使えるところがあれば、ご採用下さい。

ロードエラー、対象ノード無し等全て読み飛ばします。遅いFSOを使っていますので、あまりファイル数の多いフォルダーを指定すると、フリーズしたと思うほど時間がかかる事がありますのでご注意下さい。OKWaveリニューアル後、文字数の制限が厳しくなったので、クラスモジュールは別回答いたします。
Dim fileList As Collection
Dim FSO As Object

Sub readAllXmlFile()
Dim folderName As String
Dim i As Long, j As Long, k As Long, counter As Long
Dim findXml As findXmlClass
Dim varRet As Variant, nodeNameArray As Variant

nodeNameArray = Array("ID", "ReportID","UpDateDateTime")
folderName = "C:\Documents and Settings\hoge\" '下位フォルダも対象

Set FSO = CreateObject("Scripting.FileSystemObject")
Set fileList = New Collection
Call searchSubFolder(FSO.GetFolder(folderName)) 'XML file list作成
For i = 1 To fileList.Count
Set findXml = New findXmlClass
If findXml.loadFile(fileList(i).Path) Then
For j = 0 To UBound(nodeNameArray)
varRet = findXml.find(CStr(nodeNameArray(j)))
If Not IsEmpty(varRet) Then
For k = LBound(varRet) To UBound(varRet)
With Cells(counter, 1)
.Value = FSO.getbasename(fileList(i))
.Offset(0, 1).Value = nodeNameArray(j)
.Offset(0, 2).Value = varRet(k)
End With
counter = counter + 1
Next k
End If
Next j
Set findXml = Nothing
End If
Next i
Set FSO = Nothing
End Sub

Private Sub searchSubFolder(parentFolder As Object)
Dim subFolder As Object
Dim myFile As Object

For Each subFolder In parentFolder.SubFolders
Call searchSubFolder(subFolder)
Next subFolder
For Each myFile In parentFolder.Files
If UCase(FSO.GetExtensionName(myFile)) = "XML" Then
fileList.Add Item:=myFile
End If
Next myFile
Set parentFolder = Nothing
End Sub

No.3 回答者： mitarashi 回答日時： 2010/01/14 23:01

MSXMLを使わず、テキスト処理でやった方が、速くて簡単なのかもしれませんが、久しぶりに、復習してみました。

VB(A)から、MSXMLを利用するコードはWEB検索しても、割と断片的なものしか見つかりませんし、参考書も絶版になっているものが多い様です。興味を持たれたら、Microsoftのヘルプファイルをダウンロードしてご覧下さい。（もっと新しいバージョンのヘルプもあるかもしれません）
Sub test()
Dim oXMLDom As Object
Dim oNode As Object
Dim nodeArray As Variant
Dim nodeName As String
Dim i As Long

Set oXMLDom = CreateObject("Microsoft.XMLDOM")
nodeArray = Array("ID", "ReportID", "UpdateDateTime")

oXMLDom.async = False
oXMLDom.validateOnParse = False
oXMLDom.resolveExternals = False
If oXMLDom.Load(ThisWorkbook.Path & "\xmlTestData.xml") = False Then
MsgBox "Failed to load xml data from file."
Exit Sub
End If
For i = 0 To UBound(nodeArray)
nodeName = "//" & nodeArray(i)
Set oNode = oXMLDom.selectSingleNode(nodeName)
If Not oNode Is Nothing Then
Debug.Print nodeArray(i), oNode.Text
Set oNode = Nothing
End If
Next i
End Sub

参考URL：http://www.microsoft.com/downloads/details.aspx? …

No.2 回答者： rukuku 回答日時： 2010/01/14 22:11

続きです。

＃１で回答したような手順が可能ならば、ファイル数は変化しても構いません。Dir関数とDo～Whileを使えばフォルダ内（サブフォルダは含まない）のXMLファイル全てを順に処理することは可能です。


---以下の作業は「マクロの記録」がかなり参考になります。

XMLを通常に読み込むと、Excelはブラウザに近い読み方をします（コードそのものを取り込むのではなく、コードを解析した表示になります）。
「データ」-「外部ファイルの取り込み」-「テキストファイルのインポート」でシートに読み込んでください。

次に「置換」を使って"<"と">"を別の文字に置き換えます。"♪"のような絶対に本文中に出てきそうではないものを選びます。

そして、「データ」-「区切り位置」の「その他」で前述の文字を指定します。「連続した区切り文字は1つとして扱う」にチェックを入れておくのがベターです。

後は、「検索」で“ID”が入っているセルを探し、その右のセルの値を一覧表にコピーします。同様に“ReportID”と“UpDateTime”が入っているセルを探し、その右隣のセルの値を一覧表にコピーします。

本当は、サンプルデータでチェックしたプログラムで説明したいところですが、結構時間がかかるので、今回はプログラムの流れだけの説明です。

dd01d4081さんのやりたいこと「そのものズバリ」のやり方はなかなか見つかりませんが、細分化できれば、本やインターネットで、かなりの情報が得られます。

この回答へのお礼

ありがとうございます。

マクロの記録でも試してみたんですが、まずXMLをテキストファイルでインポートができません。。。
自分のエクセルがおかしいのでしょうか？
２００３なのでできると思っているのですが、なぜかXML形式でしか読み取ることができません。。。

もしよろしければテキストでインポートするやり方の詳細を教えていただけませんでしょうか？

こちらでも頑張ってみます。

お礼日時：2010/01/19 10:37

No.1 回答者： rukuku 回答日時： 2010/01/14 21:40

こんばんは

＞フォルダの中にさらにフォルダが入っておりその中にxmlファイルが入っております。
＞なお、xmlファイル以外のファイルが入っているフォルダもあります。

出来ますが、「全くの初心者で」という状況では困難だと思います。
私自身、ある程度仕事でVBAを使っていますし、人に教えることもありますが、以前一度インターネットでサンプルを探して試したきりなので、やり方は忘れました。

手作業で、エクスプローラの検索を使い、該当するファイルを一つのフォルダにコピーするというシステムには出来ないでしょうか？
全ての対象ファイルが同じフォルダに集まっていればマクロ作成が楽になります。
（Excel2000ですとマクロでも出来ましたが、おそらく2003あたりからは出来なくなりました。）