Importing XML files into an Access DB with multipl

Question

I have a bunch of (flat) XML files such as:

<?xml version="1.0" encoding="UTF-8"?>
<SomeName>   
  <UID>
    ID123
  </UID>
  <Node1> 
    DataA 
 </Node1>   
 <Node2> 
    DataB 
 </Node2>   
  <Node3> 
    DataC 
 </Node3>   
  <AnotherNode1> 
    DataD 
 </AnotherNode1> 
  <AnotherNode2> 
    DataE 
 </AnotherNode2> 
  <AnotherNode3> 
    DataF 
 </AnotherNode3> 
 <SingleNode> 
    DataG 
 </SingleNode> 
</SomeName>   

Now my actual XML files have too many nodes, so they can't be imported into a single table (due to the 255 column limit), so I need to split the data into multiple tables. I already created the tables by hand so now all access would have to do is match the Node names with the columns in each of the tables and copy the data.

It does so only for one table named 'SomeName', but leaves all other tables untouched.

I am unsure of how to get access to import my XML files properly into all the tables. I also already tried creating the UID field in each table and linking them (since the UID is unique to each XML dataset), but that left access unimpressed as well.

I've tried to find any sort of info on this problem, but have so far found nothing.

I would very grateful for any help or pointers.

Answer 1

Since you require more than 255 fields, you'll have to do this with code. You could load your XML into a MSXML2.DOMDocument, gather a subset of node values, build an INSERT statement, and execute it.

Here is a procedure I tested against your sample data. It's pretty ugly, but it works. Un-comment the CurrentDb.Execute line after you modify strTagList, strFieldList, strTable, and cintNumTables and review the INSERT statements. Add additional Case blocks if you have more than 2 tables to load.

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

Here are 4 links I found helpful for VBA/XML/DOM:

• Google: vba xml dom
• msdn: A Beginner's Guide to the XML DOM
• msdn: Use the XML Object Model
• Stack Overflow: How to parse XML in VBA