Excel to access - recordset problem

[paulpan]

I am trying to insert values in a range to an Access recordset. My problem is with:

rst = CreateObject("ADODB.Recordset")

and then later in:

rst.Open "INSERT INTO " & tblName & colHead & " VALUES " & rcdDetail, cnt

rst doesn't seem to be recognised at all. Help will be appreciated.


Sub DB_Insert_via_ADOSQL()
'Macro purpose: To add record to Access database using ADO and SQL
'NOTE: Reference to Microsoft ActiveX Data Objects Libary required

Dim cnt As Object, _
dbPath As String, _
tblName As String, _
rngColHeads As Range, _
rngTblRcds As Range, _
colHead As String, _
rcdDetail As String, _
ch As Integer, _
cl As Integer, _
notNull As Boolean



Set cnt = CreateObject("ADODB.Connection")
'Dim rst As Object
'Set rst = CreateObject("ADODB.Recordset")
Dim rst As Object
Set rst = CreateObject("ADODB.Recordset")


'Set the string to the path of your database as defined on the worksheet
dbPath = ActiveSheet.Range("B1").Value
tblName = ActiveSheet.Range("B2").Value
Set rngColHeads = ActiveSheet.Range("tblHeadings")
Set rngTblRcds = ActiveSheet.Range("tblRecords")

'Concatenate a string with the names of the column headings
colHead = " ("
For ch = 1 To rngColHeads.Count
colHead = colHead & rngColHeads.Columns(ch).Value
Select Case ch
Case Is = rngColHeads.Count
colHead = colHead & ")"
Case Else
colHead = colHead & ","
End Select
Next ch

'Open connection to the database
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= C:\Documents and Settings\ppanebianco\Desktop\Funds Table.mdb"


'Begin transaction processing
On Error GoTo EndUpdate
cnt.BeginTrans

'Insert records into database from worksheet table
For cl = 1 To rngTblRcds.Rows.Count

'Assume record is completely Null, and open record string for concatenation
notNull = False
rcdDetail = "('"

'Evaluate field in the record
For ch = 1 To rngColHeads.Count
Select Case rngTblRcds.Rows(cl).Columns(ch).Value
'if empty, append value of null to string
Case Is = Empty
Select Case ch
Case Is = rngColHeads.Count
rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL)"
Case Else
rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL,'"
End Select

'if not empty, set notNull to true, and append value to string
Case Else
notNull = True
Select Case ch
Case Is = rngColHeads.Count
rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "')"
Case Else
rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "','"
End Select
End Select
Next ch


'If record consists of only Null values, do not insert it to table, otherwise
'insert the record
Select Case notNull
Case Is = True
'cnt.Open
rst.Open "INSERT INTO " & tblName & colHead & " VALUES " & rcdDetail, cnt

Case Is = False
'do not insert record
End Select
Next cl

EndUpdate:
'Check if error was encounted
If Err.Number <> 0 Then
'Error encountered. Rollback transaction and inform user
On Error Resume Next
cnt.RollbackTrans
MsgBox "There was an error. Update was not succesful!", vbCritical, "Error!"
Else
On Error Resume Next
cnt.CommitTrans
End If

'Close the ADO objects
cnt.Close
Set rst = Nothing
Set cnt = Nothing
On Error GoTo 0
End Sub

 

[RoryA]

If you are going to use a recordset, you should open a recordset based on the table, then use AddNew...Update to append new records to it. If you want to use an INSERT statement, then you don't need a recordset at all, you can simply use the Connection object's Execute method to run the INSERT query.

 

[paulpan]

I dont really follow...?

 

[RoryA]

Something like this (note: it is untested!) - opening a recordset based on the table, then adding new records to it:

Sub DB_Insert_via_ADOSQL()
'Macro purpose: To add record to Access database using ADO and SQL
'NOTE: Reference to Microsoft ActiveX Data Objects Libary required

Dim cnt As Object, _
dbPath As String, _
tblName As String, _
rngColHeads As Range, _
rngTblRcds As Range, _
colHead As String, _
rcdDetail As String, _
ch As Integer, _
cl As Integer, _
notNull As Boolean



Set cnt = CreateObject("ADODB.Connection")
'Dim rst As Object
'Set rst = CreateObject("ADODB.Recordset")
Dim rst As Object
Set rst = CreateObject("ADODB.Recordset")


'Set the string to the path of your database as defined on the worksheet
dbPath = ActiveSheet.Range("B1").value
tblName = ActiveSheet.Range("B2").value
Set rngColHeads = ActiveSheet.Range("tblHeadings")
Set rngTblRcds = ActiveSheet.Range("tblRecords")

'Open connection to the database
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= C:\Documents and Settings\ppanebianco\Desktop\Funds Table.mdb"
' OPen recordset based on specified table
rst.Open tblName, cnt, , , adCmdTable


'Begin transaction processing
On Error GoTo EndUpdate
cnt.BeginTrans

'Insert records into database from worksheet table
For cl = 1 To rngTblRcds.Rows.Count
    ' Check if there is at least one data item
    If Application.CountA(rngTblRcds.Rows(cl)) > 0 Then
        rst.AddNew
        'Evaluate field in the record
        For ch = 1 To rngColHeads.Count
            Select Case rngTblRcds.Rows(cl).Columns(ch).value
                'if empty, append value of null to string
                Case Is = Empty
                    ' do nothing
                Case Else
                    ' fill in relevant field value
                    rst.Fields(rngColHeads.Cells(1, ch).value).value = rngTblRcds.Rows(cl).Columns(ch).value
            End Select
        Next ch
        ' add new record
        rst.Update
    End If
    
Next cl

EndUpdate:
'Check if error was encounted
If Err.Number <> 0 Then
'Error encountered. Rollback transaction and inform user
On Error Resume Next
cnt.RollbackTrans
MsgBox "There was an error. Update was not succesful!", vbCritical, "Error!"
Else
On Error Resume Next
cnt.CommitTrans
End If

'Close the ADO objects
cnt.Close
Set rst = Nothing
Set cnt = Nothing
On Error GoTo 0
End Sub