ADODB.Recordset .AddNew Run-time error '3251'

[mssbass]

Can anyone help me figure out where I'm going wrong with adding records to my database? I'm getting Run-time error '3251': Current Recordset does not support updating. This may be a limitation of the provider, or of the selected locktype.


Sub UploadSORData()
Dim source_sheet As String
source_sheet = "Staffing_Open_Report"

Dim FinalCol As Integer, i As Integer, FinalRow As Long, r As Long
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim arr() As String

FinalCol = ThisWorkbook.Worksheets(source_sheet).Range("A1").End(xlToRight).Column
ReDim arr(1 To FinalCol) As String
For i = 1 To FinalCol
arr(i) = ThisWorkbook.Worksheets(source_sheet).Cells(1, i).Value
Next

Set cn = New ADODB.Connection
cn.Mode = adModeShareDenyNone
cn.Open "Provider=" & GetACEVersion() & ";Data Source=" & db_path

Set rs = Nothing
Set rs = New ADODB.Recordset
rs.Open "[" & destination_table & "]", cn, adOpenDynamic, adLockOptimistic, adCmdTable

FinalRow = ThisWorkbook.Worksheets(source_sheet).Range("A1").End(xlDown).Row

For r = 2 To FinalRow
With rs
On Error GoTo AddNew
AddNew:
.AddNew
On Error GoTo 0
For i = 1 To FinalCol
If Len(ThisWorkbook.Worksheets(source_sheet).Cells(r, i).Value) > 0 Then .Fields(arr(i)) = ThisWorkbook.Worksheets(source_sheet).Cells(r, i).Value
Next
.Fields("Uploader") = Environ("username")
.Fields("Upload_Date") = Now()
.Fields("Upload_Sheet") = source_sheet
.Fields("Report_Date") = Date
.Update
End With
Next

rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
FinalRow = Empty
FinalCol = Empty
Erase arr
i = Empty

End Sub