Import XML into Access

[samonsey]

I have created a simple tool using MSXML 3 and ADO 2.6 to import an XML document into Access 97, create tables based on the hierarchy of the XML data and then populate that table structure. ADO converts the XML document into a hierarchy of nested recordsets that I sort through. This is the code

Option Compare Database
Option Explicit

Private Sub Command1_Click()
    Dim adoRS As ADODB.Recordset
    Set adoRS = New ADODB.Recordset
    Dim fld As ADODB.Field
    
    ' Set up the Connection
    adoRS.ActiveConnection = "Provider=MSDAOSP; Data Source=MSXML2.DSOControl.2.6;"
    
    ' Open the XML source
    adoRS.Open "c:\xml2.xml"
    'On Error GoTo RecError
    BuildTables adoRS, "", "Document"
    printtbl adoRS, "Document", 0, "Document"
    
    GoTo Bye
    
RecError:
    Debug.Print Err.Number & ": " & Err.Description
    If adoRS.State = adStateOpen Then
        For Each fld In adoRS.Fields
            Debug.Print fld.Name & ": " & fld.status  '  Error Status
        Next fld
    End If
    
Bye:
    If adoRS.State = adStateOpen Then
        adoRS.Close
    End If
    Set adoRS = Nothing
End Sub

' Function to recursively retrieve the data
Sub BuildTables(rs As ADODB.Recordset, strParentName As String, strCurrentName As String)
    'On Error Resume Next
    
    Dim rsChild As ADODB.Recordset
    Dim Col As ADODB.Field
    
    Dim db As Database
    Dim tdf As TableDef
    Dim fld As Field
    Dim strColName As String
    
    Set db = CurrentDb
  
    For Each tdf In db.TableDefs
        If tdf.Name = strCurrentName Then
            Exit Sub
        End If
    Next
    
    
    Set tdf = db.CreateTableDef(strCurrentName)
    Set fld = tdf.CreateField("ID", dbLong)
    fld.attributes = fld.attributes + dbAutoIncrField
    tdf.Fields.Append fld
    Set fld = tdf.CreateField("fk" & strParentName & "ID", dbLong)
    tdf.Fields.Append fld
    
    

    For Each Col In rs.Fields
        If Col.Type <> adChapter Then
            If Col.Name = &quot;$Text&quot; Then
                strColName = strCurrentName
            Else: strColName = Col.Name
            End If
            
            Set fld = tdf.CreateField(strColName, dbText, 255)
            fld.AllowZeroLength = True
            tdf.Fields.Append fld
        Else
            Set rsChild = Col.Value
            rsChild.MoveFirst
            If Err Then MsgBox Error
            BuildTables rsChild, strCurrentName, Col.Name
            rsChild.Close
            Set rsChild = Nothing
        End If
    Next
        'Debug.Print
    
    
    db.TableDefs.Append tdf
End Sub

Sub printtbl(rs As ADODB.Recordset, strTableName As String, lngParentID As Long, strParentName As String)
    On Error Resume Next
    
    Dim rsChild As ADODB.Recordset
    Dim Col As ADODB.Field
    Dim lngFK As Long
    Dim strColName As String
    
    Dim db As Database
    Dim rst As Recordset
    
    Set db = CurrentDb()
    Set rst = db.TableDefs(strTableName).OpenRecordset(dbOpenDynaset)
    
    
    While rs.EOF <> True
        rst.AddNew
        rst.Fields(&quot;fk&quot; & strParentName & &quot;ID&quot;) = lngParentID
        
        For Each Col In rs.Fields
            If Col.Type <> adChapter Then
                If Col.Name = &quot;$Text&quot; Then
                    strColName = strTableName
                Else: strColName = Col.Name
                End If
                
                rst.Fields(strColName).Value = Col.Value
                Else
                    'Retrieve the Child recordset
                    Set rsChild = Col.Value
                    rsChild.MoveFirst
                    lngFK = DMax(&quot;ID&quot;, strTableName) + 1
                    If lngFK = 0 Then lngFK = 1
                    printtbl rsChild, Col.Name, lngFK, rst.Name
                    rsChild.Close
                    Set rsChild = Nothing
            End If
        Next
        rst.Update
        rs.MoveNext
    Wend
    
End Sub

It is adapted from code found in the MSKB, hence the While...Wend construct. It is designed as code behind a form, and is fired with a command button click.

My question is whether there is a better way of doing this or if there is a free/low-cost tool out there that will do it for me. My problem is that I have XML documents that come to me without a DTD or Schema, so I have to assume they are well-formed and valid, and then I have to build the database structure into which I am putting the data.

Any help would be greatly appreciated.

Asa Monsey
samonsey@houston.rr.com
Maxim Group Consultant
Visual Basic / SQL Server