How to get an increment of records in an Access table?

**ADezii** · Feb 1 '11, 05:39 PM

The following would be the Logic for Appending Data from one Recordset to another with Fields being misaligned:

Code:

Dim MyDB As DAO.Database
Dim rst_1 As DAO.Recordset
Dim rst_2 As DAO.Recordset

Set MyDB = CurrentDb
Set rst_1 = MyDB.OpenRecordset("tblTest", dbOpenForwardOnly)
Set rst_2 = MyDB.OpenRecordset("tblAppend", dbOpenDynaset)

With rst_1
  Do While Not .EOF
    rst_2.AddNew
      'Don't forget that the Fields Collection is Indexed starting at 0
      rst_2.Fields(0) = .Fields(1)
      rst_2.Fields(1) = .Fields(2)
      rst_2.Fields(2) = .Fields(6)
      rst_2.Fields(3) = .Fields(8)
      rst_2.Fields(4) = .Fields(10)
    rst_2.Update
       .MoveNext
  Loop
End With

rst_1.Close
rst_2.Close
Set rst_1 = Nothing
Set rst_2 = Nothing

**Ehsan arman** · Feb 2 '11, 05:10 PM

Thanks ADzeii, but I am looking for is being able to merge two different recordsets from the same table into the same table. So, one recordset has all the fields in table A and the other selects only a few fields from table A. I am doing this because I am skipping two columns in excel so by opening rst_2 I am only selecting the columns that come after the skipped columns. The other problem is only seeing one row of data displayed in my table for rst_2

**ADezii** · Feb 2 '11, 05:15 PM

How about Posting some sample Data along with the desired results? In this manner, we can get a much clearer picture of exactly what you are requesting.

**Ehsan arman** · Feb 2 '11, 06:52 PM

Hi, I have attached the original spreadsheet as For Me.xls
and I also copied what I have in my Access table into book1.xls and attached them both as a zip file.
So in there you'll see that my 2nd recordset fills up columns (Field Measurement through Date), but it's only one row of data.

Attached Files

**ADezii** · Feb 2 '11, 09:03 PM

Without the Code in its entirety, and not having the Database to look at, I simply posted what I feel the general Logic may be:

Code:

Dim rs2 As DAO.Recordset
Dim strSQL As String
Dim iColumn As Integer
Dim iField As Integer
Dim lrecords1 As Long
iCol = iCol + 2    'increments the column from 28 which is where the first recordset was stopped to
                   '30 which is the starting column for the second.
  
strSQL = "SELECT [Field Measurement (m)],[Line Completed?], [Major Defects(codes only)], " & _
         "[CCTV Inspection Comments], [Date] FROM " & sTable

Set rs2 = dbs.OpenRecordset(strSQL)
  
iRow = cStartRow1
iColumn = iCol

DoCmd.Hourglass True

Do While Not wks.Cells(iRow, 30) = ""
  cStartField1 = rs2.Fields(0)
  
  iField = cStartField1
  'Do you really need this?
  lrecords1 = lrecords1 + 1    'this is the line where I am supposed to see the
                               'records incremented in the access table.
  
    For iColumn = iCol To iCol + (rs2.Fields.Count - (cStartField1 + 1))
      rs2.AddNew
        rs2.Fields(iField) = wks.Cells(iRow, iColumn)
          iField = iField + 1
            If iField = 5 Then
              rs2("Date").Value = wks.Cells(3, 3)
            End If
      rs2.Update
    Next
      iRow = iRow + 1
Loop

DoCmd.Hourglass False

rs2.Close
Set rs2 = Nothing

**Ehsan arman** · Feb 2 '11, 11:59 PM

I tried that format but it didn't work. If you look in For Me.xls you can see that from the last 4 columns in there only the first Row of data(23.0, NO, qwe, asdasd) is found in the Access Table(book1.xls ) so for some reason the records dont get incremented in the table and the other 3 rows are lost. Also, how about merging the two recordsets rst and rs2? Will I be able to do that?
I will put in the rest of the code here just in case.

Code:

Private Sub Command20_Click()

msg = ProcessFileImport(sOutput, "CCTVPipeTemporary", 8, 2, 1, 1)

End Sub

Public Function ProcessFileImport(sFile As String, sTable As String, cStartRow1 As Byte, cStartColumn1 As Byte, cStartField1 As Byte, cTab1 As Integer) As String

 Dim wbk As New Excel.Workbook
   
   Dim ExcelApp As New Excel.Application
   Dim ExcelBook As New Excel.Workbook
   Dim wks As New Excel.Worksheet
   Dim rngDefine As Excel.Range
   Dim Rng As Excel.Range
   
   ' Access object variables
   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset
   Dim sSQL As String
 
   
   Dim lrecords As Long
   Dim iRow As Integer
   Dim iCol As Integer
   Dim iFld As Integer
   Dim Message As String
  ' Dim iShot As Integer
   'Dim templ As String
   
  Set ExcelBook = ExcelApp.Workbooks.Open(sFile)
  Set wbk = ExcelApp.Workbooks.Open(sFile)
  Set wks = ExcelApp.Worksheets(cTab1)
  
     
' First Recordset
 Set dbs = CurrentDb
   sSQL = "SELECT * FROM " & sTable
   Set rst = dbs.OpenRecordset(sSQL)
  
   With rst
   .AddNew
   End With
   
   iCol = cStartColumn1
   iRow = cStartRow1
     
'Stop
   Do While Not wks.Cells(iRow, 1) = ""
   
   cStartField1 = rst.Fields(0)
         
      iFld = cStartField1
      lrecords = lrecords + 1
                
      For iCol = cStartColumn1 To cStartColumn1 + (rst.Fields.Count - (cStartField1 + 1))
                 
           If iCol = 28 Then
              Exit For
              
            End If
      
         rst.Fields(iFld) = wks.Cells(iRow, iCol)
         DoCmd.Hourglass True
         iFld = iFld + 1
                                  
      Next
     
      'iCol = cStartColumn1
      iRow = iRow + 1
      rst.Update
      rst.AddNew
   
   
   Loop
          
  ' rst.Close
  ' Set rst = Nothing
      
    Dim rs2 As DAO.Recordset
    Dim strSQL As String
    Dim iColumn As Integer
    Dim iField As Integer
    Dim lrecords1 As Long
    iCol = iCol + 2
    iFld = iFld + 3
    iField = iFld
    
    
 '2nd Recordset
    strSQL = "SELECT [Field Measurement (m)],[Line Completed?], [Major Defects(codes only)],[CCTV Inspection Comments], [Date] FROM " & sTable
    Set rs2 = dbs.OpenRecordset(strSQL)
        
     With rs2
    .AddNew
    End With
    
    'iColumn = cStartColumn1
     
    
    iRow = cStartRow1
   ' iField = cStartField1
    iColumn = iCol
  '  lrecords1 = iRow
    
    
    Do While Not wks.Cells(iRow, 30) = ""
   
    cStartField1 = rs2.Fields(0)
    
    iField = cStartField1
    lrecords1 = lrecords1 + 1
              
    For iColumn = iCol To iCol + (rs2.Fields.Count - (cStartField1 + 1))
                            
         rs2.Fields(iField) = wks.Cells(iRow, iColumn)
          
             DoCmd.Hourglass True
             iField = iField + 1
         
           '  lrecords = lrecords + 1
         
           If iField = 5 Then
              rs2("Date").value = wks.Cells(3, 3)
               lrecords = lrecords + 1
           End If
          
           DoCmd.Hourglass False
                                 
      Next
                              
      iRow = iRow + 1
      rs2.Update
      rs2.AddNew
      
   Loop
                 
      rst.Close
      Set rst = Nothing
      rs2.Close
      Set rs2 = Nothing
      
                 
   
    Ltotal = DCount("*", "CCTV_Pipe_Daily_Report")
    MsgBox ("Import Process is Done!" & vbclrf & vbCrLf & "There are" & Ltotal & " Records imported into the database")
  ' ProcessFileImport = "Number of Pipes imported into the Database: " & lRecords
   
Exit_Here:
   ' Cleanup all objects  (resume next on errors)
   On Error Resume Next
   Set wks = Nothing
   Set wbk = Nothing
   Set appExcel = Nothing
   Set ExcelApp = Nothing
   Set rst = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
   
err_Handler:
   ProcessFileImport = Err.Description
   'Me.lblMsg.Caption = Err.Description
   Resume Exit_Here
   
End Function

**ADezii** · Feb 3 '11, 02:24 AM

Rather than restructure the Code, which I think it really needs, I created a radically different approach. I Imported the entire applicable Range (B8:AG27) into a Temporary Table, then Appended specific Fields into CCTVPipeTempora ry. Rather than go into specifics, download the Attachment and see if it can be of any use to you.

P.S. - Don't forget to change the Value of the Constant (conPATH) to point to your Excel Spreadsheet (For Me.xls).

Attached Files

Test.zip (21.2 KB, 184 views)

**Ehsan arman** · Feb 3 '11, 03:33 PM

oh I can't open the file Test.zip. It says "the file is located outside your intranet or on an untrusted site"

**ADezii** · Feb 3 '11, 03:44 PM

Talk to your Network Administrator who should be able to fix the problem.

**Ehsan arman** · Feb 3 '11, 04:00 PM

ok I will try but I dont know how long it will take them to respond. But for now, Can you please put the information into another file like maybe a text file or Excel file. I think If you have set up a table in that Access file you can copy it into Excel and attach it here. Thank you.

**ADezii** · Feb 3 '11, 04:51 PM

Code:

Dim strDate As String
Dim MyDB As DAO.Database
Dim rst_1 As DAO.Recordset
Dim rst_2 As DAO.Recordset
Dim ExcelApp As New Excel.Application
Dim ExcelBook As New Excel.Workbook
Dim wks As New Excel.Worksheet

'Substitute you own PATH for For Me.xls
Const conPATH As String = "C:\Stuff\For Me.xls"

DoCmd.Hourglass True

'Import Errors on Fields F27 and F28 (irrelevant)
CurrentDb.TableDefs.Delete "_ImportErrors"

'DELETTE ALL Records from tblTemp Table and CCTVPipeTemporary
CurrentDb.Execute "DELETE * FROM tblTemp;", dbFailOnError
CurrentDb.Execute "DELETE * FROM CCTVPipeTemporary;", dbFailOnError

'Retrieve the Date from Cells(3,3)
Set ExcelBook = ExcelApp.Workbooks.Open(conPATH)
strDate = ExcelBook.Worksheets("yyyy-mm-dd").Cells(3, 3).Value

ExcelApp.Quit
Set ExcelApp = Nothing

'populate a TEMP table (tblTemp with the entire Spreadsheet Range)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tblTemp", conPATH, False, "B8:AG27"

Set MyDB = CurrentDb
Set rst_1 = MyDB.OpenRecordset("tblTemp", dbOpenForwardOnly)
Set rst_2 = MyDB.OpenRecordset("CCTVPipeTemporary", dbOpenDynaset)

With rst_1
  Do While Not .EOF
    If Not IsNull(![F29]) And Not IsNull(![F30]) And Not IsNull(![F31]) And Not IsNull(![F32]) Then
      rst_2.AddNew
        rst_2![Field Measurement] = ![F29]
        rst_2![Line Complete] = ![F30]
        rst_2![Major Defects] = ![F31]
        rst_2![Comments] = ![F32]
        rst_2![Date] = strDate
      rst_2.Update
    End If
      .MoveNext
  Loop
End With

DoCmd.Hourglass False

rst_1.Close
rst_2.Close
Set rst_1 = Nothing
Set rst_2 = Nothing

'Let's see the results
DoCmd.OpenTable "CCTVPipeTemporary", acViewNormal, acReadOnly
DoCmd.Maximize

**Ehsan arman** · Feb 3 '11, 06:11 PM

Thanks, but unfortunately the TransferSpreads heet() method fails for my Excel file just because of the way the Headings in blue text are. They are spread over two lines(rows 6 and 7) and the TransferSpreads heet method doesn't like that and I am not allowed to change the spreadsheet. So I have to just stick to using loops to put in the data. With the loops Can I merge the two recordsets?

**ADezii** · Feb 3 '11, 06:23 PM

@Ehsan - Doesn't the first Row to be processed begin at Row #8, as indicated by the 3rd Argument in the Function, namely:

Code:

ProcessFileImport(sOutput, "CCTVPipeTemporary", 8, 2, 1, 1)

**Ehsan arman** · Feb 3 '11, 08:27 PM

Yes thats right, thats the row where the data values start, row 8. But nevertheless, the TransferSpreads heet method looks also at the titles for each column and since the columns run over two rows(6 and 7) it generates an error. When using loops, I ignored reading the column titles and just read in the data from row 8 onward to get around that error. Thats why I decided to use For loops rather than the TransferSpreads heet method.