Run-Time Error -2147217887 80040e21 ODBC Call Failed

[Jani]

Importing data from an Excel file into a SQL table used in an Access db. For
about two years the process has worked without any glitches (thanks if memory
serves me correctly because an MVP helped with the code) and now the error in
the Subject field message is being displayed when one tries to export data.
The code is shown below and stops at:
.Update ' stores the new record

Nothing has changed with the code, SQL table or the Access db. I've pulled a
couple of Excel files from last week where the data was exported correctly
and now the error message is displayed. Somewhere I read that the issue may
be the 'regsvr32.exe' file so I did a search and find that on 6/7/09 the
file, REGSVR32.EXE-25EEFE2F.pf, was loaded to c:\WINDOWS\Prefetch on my
laptop which may be from an automatic update done by IT. Could this file be
causing the problem?

The code is also shown below in its entirety. Help needed! Thanks!!! Jani

Sub ADOFromExcelToAccess2()
' exports data from the active worksheet to a SQL table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\DT\CARMGMT\CapitalExpenditure.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "dbo_uCARCostSavings", cn, adOpenKeyset, adLockOptimistic,
adCmdTable
' all records in a table
r = 2 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("ProjectNbr") = Range("A" & r).Value
.Fields("SavingsDate2") = Range("B" & r).Value
.Fields("IncrementalOI") = Range("C" & r).Value
.Fields("MfgLbrCostSvgs") = Range("D" & r).Value
.Fields("MfgSupCostSvgs") = Range("E" & r).Value
.Fields("MfgAllOtherCostSvgs") = Range("F" & r).Value
.Fields("IPWLbrCostSvgs") = Range("G" & r).Value
.Fields("IPWPltSuppCostSvgs") = Range("H" & r).Value
.Fields("IPWAllOtherCostSvgs") = Range("I" & r).Value
.Fields("PltAdmLbrCostSvgs") = Range("J" & r).Value
.Fields("PltAdmEngyCostSvgs") = Range("K" & r).Value
.Fields("PltAdmWtrCostSvgs") = Range("L" & r).Value
.Fields("PltAdmWasteCostSvgs") = Range("M" & r).Value
.Fields("PltAdmSldWasteHauCostSvgs") = Range("N" & r).Value
.Fields("PltAdmAllOtherCostSvgs") = Range("O" & r).Value
.Fields("ForkTrkCostSvgs") = Range("P" & r).Value
.Fields("RelLbrCostSvgs") = Range("Q" & r).Value
.Fields("RelMfgEquipCostSvgs") = Range("R" & r).Value
.Fields("RelIPWEquipCostSvgs") = Range("S" & r).Value
.Fields("RelAllOtherCostSvgs") = Range("T" & r).Value
.Fields("MtlLossCostSvgs") = Range("U" & r).Value
.Fields("TransCustDelCostSvgs") = Range("V" & r).Value
.Fields("TransCustInterWhseCostSvgs") = Range("W" & r).Value
.Fields("TransFleetCostSvgs") = Range("X" & r).Value
.Fields("PPVRawMatlCostSvgs") = Range("Y" & r).Value
' add more fields if necessary...
.Update ' stores the new record (THIS IS THE LINE HIGHLIGHTED)
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
MsgBox "The cost savings data export has finished!"
End Sub