Exporting Data from Excel (Dynamic Range) to Access Table

[itsmefeddi]

Hi all,

I am having trouble in the below code its keep getting me error on line
rst.Fields(Cells(1, i).Value) = Cells(x, i).Value

i dont know what the problem is please help me out.

the complete code is here

Sub Export_Data()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim dbPath As String, TblName As String
Dim x As Long, i As Long
Dim nextrow As Long, lastcolmn As Long
Dim ws As Worksheet

TblName = "SubCategoryList"
Set ws = ThisWorkbook.Worksheets(TblName)
ws.Activate

dbPath = "D:\WMS\DataBase\wms.accdb"
nextrow = Cells(Rows.Count, 1).End(xlUp).Row
lastcolmn = Range("IV1").End(xlToLeft).Column

'Initialise the collection class variable
Set cnn = New ADODB.Connection

If ws.Range("A2").Value = "" Then
MsgBox " Add the data that you want tot send to MS Access"
Exit Sub
End If

cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
cnn.ConnectionString = "D:\WMS\DataBase\wms.accdb"
cnn.Open

Set rst = New ADODB.Recordset
rst.Open TblName, cnn, adOpenDynamic, adLockOptimistic, adCmdTable

For x = 2 To nextrow
rst.AddNew
For i = 1 To lastcolmn
rst.Fields(Cells(1, i).Value) = Cells(x, i).Value
Next i
rst.Update
Next x

rst.Close

cnn.Close

Set rst = Nothing
Set cnn = Nothing

Application.ScreenUpdating = True

End Sub

 

[itsmefeddi]

and the error i am getting at present is

Multiple step OLE-DB operations generated error, Check each OLEDB status value

Hi all,

I am having trouble in the below code its keep getting me error on line
rst.Fields(Cells(1, i).Value) = Cells(x, i).Value

i dont know what the problem is please help me out.

the complete code is here

Sub Export_Data()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim dbPath As String, TblName As String
Dim x As Long, i As Long
Dim nextrow As Long, lastcolmn As Long
Dim ws As Worksheet

TblName = "SubCategoryList"
Set ws = ThisWorkbook.Worksheets(TblName)
ws.Activate

dbPath = "D:\WMS\DataBase\wms.accdb"
nextrow = Cells(Rows.Count, 1).End(xlUp).Row
lastcolmn = Range("IV1").End(xlToLeft).Column

'Initialise the collection class variable
Set cnn = New ADODB.Connection

If ws.Range("A2").Value = "" Then
MsgBox " Add the data that you want tot send to MS Access"
Exit Sub
End If

cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
cnn.ConnectionString = "D:\WMS\DataBase\wms.accdb"
cnn.Open

Set rst = New ADODB.Recordset
rst.Open TblName, cnn, adOpenDynamic, adLockOptimistic, adCmdTable

For x = 2 To nextrow
rst.AddNew
For i = 1 To lastcolmn
rst.Fields(Cells(1, i).Value) = Cells(x, i).Value
Next i
rst.Update
Next x

rst.Close

cnn.Close

Set rst = Nothing
Set cnn = Nothing

Application.ScreenUpdating = True

End Sub