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

[Ehsan arman]

I am using two recordsets for inputting data into an access table. I have used two loops for each recordset to do so. My intent is to read data into the table from an Excelsheet. My first recordset selects all columns from the excelsheet and does what it is supposed to do. The second recordset selects only a handful of columns from the Excelsheet, but when using the second recordset I am only able to get the first row of data transferred into the table and not able to get all rows of data in. The second recordset starts from column number 30 and field number 27 in the table. The format of the first Recordset is very similar the only difference being that the 1st one uses cStartColumn1 as input in the function argument inside the for loop and the second one uses iCol which indicates the location of current column to which the cursor is pointing to. I will include the code for the second recordset here:

 
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)
 
 
     With rs2
    .AddNew
     End With
 
 iRow = cStartRow1
 iColumn = iCol
 
 Do While Not wks.Cells(iRow, 30) = ""
 
    cStartField1 = rs2.Fields(0)
 
    iField = cStartField1
    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.Fields(iField) = wks.Cells(iRow, iColumn)
         DoCmd.Hourglass True
         iField = iField + 1
 
If iField = 5 Then
         rs2("Date").value = wks.Cells(3, 3)
                 End If
 
      Next
 
iRow = iRow + 1
      rs2.Update
      rs2.AddNew
 
    loop
 
      rs2.Close
      Set rs2 = Nothing
 
 

[ADezii]

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

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]

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]

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]

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.

[ADezii]

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:

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]

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.

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]

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).

[Ehsan arman]

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

[ADezii]

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