Поскольку вам требуется более 255 полей, вам придется делать это с помощью кода.Вы можете загрузить свой XML в MSXML2.DOMDocument, собрать подмножество значений узлов, построить оператор INSERT и выполнить его.
Вот процедура, которую я протестировал на данных вашего образца.Это довольно некрасиво, но это работает.Снимите комментарий со строки CurrentDb.Execute после изменения strTagList, strFieldList, strTable и cintNumTables и просмотрите операторы INSERT.Добавьте дополнительные блоки Case, если у вас есть более 2 таблиц для загрузки.
Public Sub Grinner(ByRef pURL As String)
Const cintNumTables As Integer = 2
Dim intInnerLoop As Integer
Dim intOuterLoop As Integer
Dim objDoc As Object
Dim objNode As Object
Dim strFieldList As String
Dim strMsg As String
Dim strSql As String
Dim strTable As String
Dim strTag As String
Dim strTagList As String
Dim strUID As String
Dim strValueList As String
Dim varTags As Variant
On Error GoTo ErrorHandler
Set objDoc = GetXMLDoc(pURL)
Set objNode = objDoc.getElementsByTagName("UID").Item(0)
strUID = objNode.Text
For intOuterLoop = 1 To cintNumTables
Select Case intOuterLoop
Case 1
strTable = "Table1"
strTagList = "Node1,Node2,Node3,AnotherNode1"
strFieldList = "UID, N1, N2, N3, A1"
Case 2
strTable = "Table2"
strTagList = "AnotherNode2,AnotherNode3,SingleNode"
strFieldList = "UID, A2, A3, SN"
Case Else
'oops!
strTable = vbNullString
End Select
If Len(strTable) > 0 Then
varTags = Split(strTagList, ",")
strValueList = "'" & strUID & "'"
For intInnerLoop = 0 To UBound(varTags)
strTag = varTags(intInnerLoop)
Set objNode = objDoc.getElementsByTagName(strTag).Item(0)
strValueList = strValueList & ", '" & _
Replace(objNode.Text, "'", "''") & "'"
Next intInnerLoop
strSql = "INSERT INTO " & strTable & " (" & _
strFieldList & ")" & vbNewLine & _
"VALUES (" & strValueList & ");"
Debug.Print strSql
'CurrentDb.Execute strSql, dbFailOnError
End If
Next intOuterLoop
ExitHere:
Set objNode = Nothing
Set objDoc = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure Grinner"
MsgBox strMsg
GoTo ExitHere
End Sub
Public Function GetXMLDoc(pURL) As Object
' early binding requires reference, Microsoft XML
'Dim objDoc As MSXML2.DOMDocument30
'Dim objParseErr As MSXML2.IXMLDOMParseError
'Set objDoc = New MSXML2.DOMDocument30
' late binding; reference not required
Dim objDoc As Object
Dim objParseErr As Object
Dim strMsg As String
On Error GoTo ErrorHandler
Set objDoc = CreateObject("Msxml2.DOMDocument.3.0")
objDoc.async = False
objDoc.validateOnParse = True
objDoc.Load pURL
If (objDoc.parseError.errorCode <> 0) Then
Set objParseErr = objDoc.parseError
MsgBox ("You have error " & objParseErr.reason)
Set objDoc = Nothing
End If
ExitHere:
Set objParseErr = Nothing
Set GetXMLDoc = objDoc
On Error GoTo 0
Exit Function
ErrorHandler:
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure GetXMLDoc"
MsgBox strMsg
Set objDoc = Nothing
GoTo ExitHere
End Function
Вот 4 ссылки, которые я нашел полезными для VBA / XML / DOM: