Sub open_and_process_infopath_xml()
On Error GoTo err_end
' ADO variables
Dim conn As ADODB.Connection
Set conn = CurrentProject.Connection
Set recset = New ADODB.Recordset
' DOM variables
Dim xml_file As DOMDocument
Dim slsperson As IXMLDOMElement
Dim order_date As IXMLDOMElement
Dim orders As IXMLDOMNodeList
Dim order As IXMLDOMElement
Dim lineitems As IXMLDOMNodeList
Dim lineitem As IXMLDOMNode
Set xml_file = New DOMDocument
' other variables
Dim ssql As String
Dim book_title As String
Dim order_quantity As Integer
Dim this_order_key As Integer
Dim file_count As Integer
Dim getlines As Integer
Dim myFileSearch As FileSearch
Set myFileSearch = Application.FileSearch
' clear Access tables
ssql = "Delete * From tblLineItems"
conn.Execute (ssql)
ssql = "Delete * From tblOrders"
conn.Execute (ssql)
' work with XML files in specified directory
With myFileSearch
  .NewSearch
  ' change path as necessary
  .LookIn = "C:\Book Orders"
  .SearchSubFolders = False
  .Filename = "*.xml"
  If .Execute() > 0 Then
    file_count = .Execute()
    For Each myfile In .FoundFiles
      ' open XML file with parser
       xml_file.async = False
       xml_file.Load myfile
         ' isolate salesperson
       Set slsperson = _
         xml_file.selectSingleNode("//SalesPerson")
      ' isolate order date
       Set order_date = _
         xml_file.selectSingleNode("//Date")
      ' create node list of all orders in the file
       Set orders = xml_file.selectNodes("//Order")
       ' for each order in the file, write a record in tblOrders
       For Each order In orders
          ssql = "Insert Into tblOrders (Customer, PONumber, "
          ssql = ssql & "OrderDate, SalesPerson)"
          ssql = ssql & " Values ("
          ssql = ssql & "'" & order.childNodes(0).Text & "', "
          ssql = ssql & "'" & order.childNodes(1).Text & "', "
          ssql = ssql & "#" & order_date.Text & "#, "
          ssql = ssql & "'" & slsperson.Text & "')"
          conn.Execute (ssql)
         ' get the new order key
         ' it has just been written to the orders table
         ' so getting the max of OrderKey returns the key number
         ' needed for the detail table
         ssql = "Select Max(OrderKey) From tblOrders"
         ' open a recordset with the SQL statement
         ' it will have one record with one field
         ' which is the OrderKey just created
         recset.Open ssql, conn, adOpenKeyset
         ' store the OrderKey and close the recordset
         this_order_key = recset.Fields(0)
         recset.Close
         ' Using the OrderKey,
         ' populate the LineItems table
         ' with the details of the order
         ' this loop starts at 2 (the 3rd child
         ' in a zero-based collection) because the first 2
         ' children are the Customer and PONumber - which have
         ' been processed above in the first SQL Insert.
         ' The line items are children of the LineItem element;
         ' there can be any number of LineItem elements
         For getlines = 2 To order.childNodes.length - 1
           book_title = _
              order.childNodes(getlines).childNodes(0).Text
           order_quantity = _
              order.childNodes(getlines).childNodes(1).Text
           ssql = "Insert Into tblLineItems "
           ssql = ssql & "(OrderKey, Title, Quantity)"
           ssql = ssql & " Values ("
           ssql = ssql & this_order_key & ", "
           ssql = ssql & "'" & book_title & "', "
           ssql = ssql & order_quantity & ")"
           conn.Execute (ssql)
        Next
     Next
   Next
  End If
End With
MsgBox file_count & " files processed"
Exit Sub
err_end:
MsgBox "This error occurred:  " & Err.Description
End Sub