Transmit data from Excel to Access table - excel

Question

After going through online forums, I have developed some code to pull data from an X Access database and place within an excel, which is working successfully. From there, I want to take this data and place within another Access database. Think of the excel as the intermediary where, at some point (this is a project given by my boss), the excel will help produce calculations and that info will be taken to the other Access database. For the time being, I just want X Access data to be placed into Y Access sheet. I am having an issue with that placement. In Y Access database I want to head to the last row, insert a row, and place the data within. Sounds easy, but giving me a problem at the end in the DataPost() sub. For the below:
For i = 1 To oSelect.Rows.Count
oRS.AddNew
For j = 1 To oSelect.Columns.Count
oRS.Fields(j) = oSelect.Cells(i, j)
Next j
oRS.Update
Next i
oDB.Close
I am getting a Run-time error 3265 saying Item not found in this collection. I can walk through the code and see the data being selected, but when it gets to the end gives me that error.
I am using DAO connections, code below for the Pull and Post (problem) code. Online I see a lot of other options such as ADO, but I can't add outside of DAO connections I believe. I want to be able to provide the DataPull info as well so you can see my DAO logic I got from some others online.
The SQL Select is much longer, but was having error placing it within this forum so cut it down.
Sub DataPull()
Const DbLoc As String = "C:\WIP\PullSample.accdb"
Dim db As DAO.Database, rs As DAO.Recordset, wkb As Workbook, wks As Worksheet, wks2 As Worksheet, recCount As Long
Dim SQL As String, i As Double, n As Double, lr As Double, t As Double
Set wkb = ActiveWorkbook
Set wks = wkb.Worksheets(1)
Set wks2 = wkb.Worksheets(2)
Set db = OpenDatabase(DbLoc)
SQL = "SELECT [AA-AM].Dates, [AA-AM].[A US Equity]"
SQL = SQL & "FROM [AA-AM] "
SQL = SQL & "WHERE [AA-AM].Dates = Date() "
Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
wks2.Range("B5").CopyFromRecordset rs
wks2.Range("B5:GG5").Font.Name = "Garamond"
wks2.Range("B5:GG5").Font.Size = 10
wks2.Range("C5:GG5").Copy
wks.Range("D6").PasteSpecial Transpose:=True
Set rs = Nothing
Set wks = Nothing
Set wks2 = Nothing
Set wkb = Nothing
End Sub
Sub DataPost()
Dim oSelect As Range, i As Long, j As Integer, sPath As String
Dim lr as long
Dim wkb As Workbook, wks As Worksheet, wks2 As Worksheet
Dim oDAO As DAO.DBEngine, oDB As DAO.Database
Dim oRS As DAO.Recordset
Const DbLoc As String = "C:\WIP\ProjPullDB.accdb"
Set wkb = ActiveWorkbook
Set wks = wkb.Worksheets(1)
Set wks2 = wkb.Worksheets(2)
Set oSelect = wks2.Range("B5:GG5")
'wks2.Activate
'oSelect.Copy
Set oDAO = New DAO.DBEngine
Set oDB = oDAO.OpenDatabase(DbLoc)
Set oRS = oDB.OpenRecordset("AA-AM")
For i = 1 To oSelect.Rows.Count
oRS.AddNew
For j = 1 To oSelect.Columns.Count
oRS.Fields(j) = oSelect.Cells(i, j)
Next j
oRS.Update
Next i
oDB.Close
End Sub
I expect to be able to place the oSelect data wk2.Range("B5:GG5") data into the Y Access database last row, but no luck.

Answer 1

The error is here
For j = 1 To oSelect.Columns.Count
oRS.Fields(j) = oSelect.Cells(i, j)
Next j
Fields is a zero based array so you are putting the data into the wrong field and when you get to the last column you attempt to access a field that isn't there. You want
For j = 1 To oSelect.Columns.Count
oRS.Fields(j-1) = oSelect.Cells(i, j)
Next j