excelvbaでxmlファイルの内容の抽出

質問

excelvbaでDomを使用し指定したxmlファイルを読み込んでselectNodes("")で欲しい内容を抽出をすることは出来ました。
しかしxmlファイルが大量にあり一つ一つファイルを指定して抽出するのは時間がかかりすぎてしまいます。
ですのでフォルダ内にあるすべてのxmlファイルからselectNodes("")で欲しい内容を抽出したいのですが出来ますでしょうか？

また抽出したものをmdbのテーブルにレコードとして保存したいのですが
現在はexcelのセルに書き込んでからmdbに入れているのですが
vbaで欲しい内容を抽出した結果をそのままmdbに保存する方法はありますか？

お願い致します。

下記に指定したxmlファイルを読み込んで欲しい内容を抽出するというのを行ったときのものを載せておきます。

Dim XDoc As MSXML2.DOMDocument
Dim Node As MSXML2.IXMLDOMNode

Sub てすと()

Set XDoc = New MSXML2.DOMDocument

If XDoc.Load(ThisWorkbook.Path & "\テスト.xml") = False Then

With XDoc.parseError
Debug.Print .errorCode & " / " & Replace(.reason, vbCrLf, "")
Debug.Print "行 :" & .Line & " , カラム :" & .linepos
Debug.Print "内容 :" & .srcText
Debug.Print ""
Debug.Print "ファイル(URL) :" & .url
Debug.Print "ファイル先頭からの位置 :" & .filepos
End With

Exit Sub
End If

Debug.Print "読み込み成功"

For Each Node In XDoc.selectNodes("抽出したい内容")

Cells(1, 1) = Node.Text

Debug.Print Node.Text

Next

Set XDoc = Nothing

End Sub

回答No.1

mitarashi

フォルダー内の全xmlファイル処理については別途ご質問をたてられているので、次の部分だけ回答します。

>vbaで欲しい内容を抽出した結果をそのままmdbに保存する方法はありますか？

mdbはエクセルのファイルと同じフォルダーにあるとします。mdb名、table名は実際に合わせてアレンジ要です。
ActiveX Data Object(ADO)というのを用いております。Accessのサイトですが、下記が詳しいです。
'http://www.accessclub.jp/ado/16.html

Const adOpenKeyset As Long = 1
Const adLockOptimistic As Long = 3

Sub test()
Dim myCon As Object
Dim myRS As Object
Dim conStr As String
Dim fileFullPath As String
Dim dbFileName As String
Dim dbTableName As String

'準備
dbFileName = "Database1.mdb"
' dbFileName = "Database1.accdb"
dbTableName = "Table1"
fileFullPath = ThisWorkbook.Path & "\" & dbFileName
conStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fileFullPath
' accdb形式の時
' conStr = "Provider=Microsoft.Ace.OLEDB.12.0;" & _
' "Data Source=" & fileFullPath
Set myCon = CreateObject("ADODB.Connection")
With myCon
.connectionstring = conStr
.Open
End With
Set myRS = CreateObject("ADODB.Recordset")
myRS.Open dbTableName, myCon, adOpenKeyset, adLockOptimistic

'データの追加例、フィールドが3個ある場合
'これをループ内で実行する
With myRS
.AddNew
.Fields(0).Value = "001"
.Fields(1).Value = "data001_1"
.Fields(2).Value = "data001_2"
.Update
End With

'後始末
myRS.Close: Set myRS = Nothing
myCon.Close: Set myCon = Nothing
End Sub