access VBA 遅延バインディング でとなると難しいです
https://vbaexcel.slavesystems.com/vba/?p=603 を参考にさせてもらい、accessのVBAなので二次元配列にノード名と値を入れ込む
再帰プロシージャ、難しい。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
Option Compare Database Private aryxml() As String Private ixml As Long Public Function parsexml() Dim XML Dim strfilepath As String Dim returnary As Variant Dim returnvalue As Integer WizHook.Key = 51488399 returnvalue = WizHook.GetFileName(0, "", "", "", strfilepath, "", "すべてのファイル (*.*)|*.*", 0, 0, 8, True) WizHook.Key = 0 returnary = Array(returnvalue, strfilepath) If returnary(0) = -302 Then Exit function End If if not instr(returnary(1),chr(9))=0 then MsgBox “選択は一つにお願いします。” Exit function End if 'Debug.Print returnary(1) Set XML = CreateObject("MSXML2.DOMDocument.6.0") XML.Load (returnary(1)) If (XML.parseerror.errorcode <> 0) Then MsgBox XML.parseerror.reason, vbCritical End If ixml = 0 Call getchildren(XML) 'Debug.Print "ubound " & UBound(aryxml, 2) 'Debug.Print aryxml(0, 0) & " " & aryxml(0, 1) & " " & aryxml(0, 2) 'Debug.Print aryxml(1, 0) & " " & aryxml(1, 1) & " " & aryxml(1, 2) Set XML = Nothing ‘Erase aryxml End Function Private Function getchildren(xmlparent As Variant) On Error Resume Next Dim e For Each e In xmlparent.childnodes If e.childnodes.length = 0 Then If Not xmlparent.basename = "" Then ReDim Preserve aryxml(1, ixml) aryxml(0, ixml) = xmlparent.basename aryxml(1, ixml) = e.text End If Else Call getchildren(e) End If Next ixml = ixml + 1 End Function |