Thousands and Thousands and Thousands of New Records (1 Viewer)

[ccg_0004]

ARRR! I know that this was working at one time, then I tried to tweak it and everything went to hell in a handbasket. Can I say that on this forum? Anyways, I am importing XML files into a temporary table (because the data must go into related tables and the import funtion is unable to handle that due to autonumbering, yada yada yada...).

From this temporary table I use code to Insert a new record to the correct table. When the autonumber is generated I grab the autonumber and use it when adding the second series of data (in the related table, with the related autonumber.

Here's the code:

Private Sub Command5_Click()
    Option Explicit
    Dim HoldID As Long, rst As DAO.Recordset
    Dim rstSrc As DAO.Recordset
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset( _
              "SELECT * FROM InvoiceID WHERE 1=0")
    Set rstSrc = dbs.OpenRecordset( _
                 "SELECT * FROM Invoice_Temp WHERE 1=0")
    With rstSrc
        If (.RecordCount) Then
            .MoveFirst
            Do Until .EOF
                rst.AddNew
                rst!Notes = .Fields!Notes
                rst!Customer = .Fields!Customer
                HoldID = rst!TestID
                rst.Update
            Loop
        End If
    End With
    rst.Close
    Set rst = Nothing
    Dim rst2 As DAO.Recordset, rstSrc2 As DAO.Recordset
    Set dbs = CurrentDb
    Set rst2 = dbs.OpenRecordset( _
               "SELECT * FROM [Invoice Details] WHERE 1=0")
    Set rstSrc2 = dbs.OpenRecordset( _
                  "SELECT * FROM Invoice_Temp WHERE 1=0")
    With rstSrc2
        If (.RecordCount) Then
            .MoveFirst
            Do Until .EOF
                rst2.AddNew
                rst2!InvoiceID = HoldID
                rst2!ToolID = .Fields!ToolID
                rst2.Update
            Loop
        End If
    End With
    rst2.Close
    Set rst2 = Nothing

End Sub

The problems I am getting are that either nothing is happening at all or that I get 60000 records in the first table but nothing in the second.

CG

 

[RuralGuy]

I would start by putting Option Explicit at the top of your code module and then fix the problem it finds. Then I would install Smart Indenter and let it show you the other problems.

 

[ccg_0004]

Problem Solved for all those interested.

This code is for use when you need to import data from an XML file into tables with a Parent-Child relationship. This code works for all files in a directory and then moves them to an archive folder.

The code imports XML into a temporary table. The Parent table data is added and then the autonumber for that record is stored. Then the Child data is added, including the autonumber. This loops for each record in the temporary table.

Then all records in the temp table are deleted and all files in the directory are moved to an archive location.

Took me a while... let me know if anyone has any suggestions...

Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
 
'//This first section gathers the XML files in a directory and imports them into a temporary table
  DoCmd.SetWarnings False
  path = "C:\"
 
  'Loop through the folder & build file list
  strFile = Dir(path & "*.xml")
 
  While strFile <> ""
     'add files to the list
     intFile = intFile + 1
     ReDim Preserve strFileList(1 To intFile)
     strFileList(intFile) = strFile
      strFile = Dir()
  Wend
 
  'see if any files were found
  If intFile = 0 Then
    MsgBox "No files found"
    Exit Sub
  End If
 
  'cycle through the list of files
  For intFile = 1 To UBound(strFileList)
    filename = path & strFileList(intFile)
   
'//Here the XML files are imported into the temporary table 
 Application.ImportXML filename, acAppendData
  
  Next intFile
 
  DoCmd.SetWarnings True    
'//Begin moving data from the temporary table to the parent and child tables
Dim rs As DAO.Recordset
    Dim rs_to As DAO.Recordset
    Dim strSQL As String
    Dim strSQL_to As String
    Dim strsql2 As String
    Dim strsql2_to As String
    Dim holdid As Long
    Dim rs2 As DAO.Recordset
    Dim rs2_to As DAO.Recordset
    Set db = CurrentDb()
    strSQL = "SELECT * FROM XXENTERSOURCETABLEHERE"
    strSQL_to = "SELECT * FROM XXENTERPARENTTABLEHERE"
    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
    Set rs_to = db.OpenRecordset(strSQL_to, dbOpenDynaset)
   
    strsql2_to = "SELECT * FROM XXENTERCHILDTABLEHERE"
    Set rs2_to = db.OpenRecordset(strsql2_to, dbOpenDynaset)
    With rs
        If (.RecordCount) Then
            .MoveFirst
            Do Until .EOF
              rs_to.AddNew
                rs_to.Fields!DESTINATIONFIELDNAME = rs.Fields!SOURCEFIELDNAME
                rs_to.Fields!DESTINATIONFIELDNAME2 = rs.Fields!SOURCEFIELDNAME2
                
  holdid = rs_to!ENTERAUTONUMBERIDFIELDHERE '//This grabs parent table autonumber for use later
              rs_to.Update
                With rs
                    rs2_to.AddNew
                    rs2_to!CHILDRELATEDIDFIELDNAME = holdid '// Where the autonumber is reused to maintain the relationship
                    rs2_to.Fields!DESTINATIONFIELDNAME = rs.Fields!SOURCEFIELDNAME
                    rs2_to.Fields!DESTINATIONFIELDNAME2 = rs.Fields!SOURCEFIELDNAME2
                    rs2_to.Update
                End With
                
                 .MoveNext
            Loop
        End If
    End With
 
    Set rs_to = Nothing
    Set rs2 = Nothing
    Set db = Nothing
    Set rs2_to = Nothing
    Set rs = Nothing
    Set rs = Nothing
    Set rs_to = Nothing
'//Now move XML files
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile "C:\*.xml", "c:\XMLArchive"
'//Now delete all records in the temporary table
CurrentDb.Execute "qry_DeleteAllInvoiceTempRecords"