A developed process is necessary to correctly import the data into the specified tables and maintain relational information while doing so. The MSXML Parser library has all the functionality needed to handle this task. With regard to the requirement to read through multiple files, the FileSearch object is used to identify the XML files and process them via a loop. Listing 16.1 contains the complete code solution.
Code View:
Scroll
/
Show All 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 |