Recordset update not updating database.xlsx

[switters_aka]

I am using the following code to update a recordset from data on a form.....and it doesn't work. I was expecting to see the new data on the PRDb.xlsx, which is the database I have on the company server but there were no updates. I am new to ADODB connections and recordsets and haven't a clue where to go from here. Any advice would be much appreciated. Thanks in advance.

Sub load_lines() 'puts lines from PR into PRDb
Dim pr_array As Variant, z As Range, item As Integer, y As Range, colctr As Integer, rowLoop As Integer, columnLoop As Integer, _
lastRow As Integer
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    Dim RSCount As Integer
    Dim FieldCount As Integer
    Dim i, j As Integer
    Dim NoRecords As Boolean
    Dim FilePath As String
    Dim FileName As String
    Dim myarray As Variant
    Dim ctr As Integer
    With Application.Worksheets("PRF")
    item = 0
    ReDim pr_array(0 To 11, 0 To 8)
        For Each z In .Range("A6:A14")
            If z.Value <> "" Then
                pr_array(0, item) = "In Process" 'Status
                pr_array(1, item) = .Range("M1") 'PR#
                pr_array(2, item) = pr_date 'PR Date
                pr_array(3, item) = .Range("B" & z.Row) ' line description
                pr_array(4, item) = .Range("I" & z.Row) 'T1
                pr_array(5, item) = .Range("J" & z.Row) 'T2
                pr_array(6, item) = .Range("K" & z.Row) 'T3
                pr_array(7, item) = .Range("L" & z.Row) 'Acc Code
                pr_array(8, item) = .Range("M" & z.Row) 'eup
                pr_array(9, item) = .Range("G" & z.Row) 'QTY
                pr_array(10, item) = .Range("H" & z.Row) 'UNITS
                pr_array(11, item) = .Range("N" & z.Row) 'Estimated Total Price
            item = item + 1
            End If
    
        Next z
    
    End With
ReDim Preserve pr_array(0 To 11, item)
Application.ScreenUpdating = False
Set cn = New ADODB.Connection
    Set prdbWks = Application.Worksheets("PRDb")
    
    FilePath = "O:\Programs\WATR\EHPRs\"
    FileName = "PRDb.xlsx"
    strSQL = "SELECT * FROM [PRDb$]"
    
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FilePath & FileName & ";" & _
            "Extended Properties=Excel 12.0;"
        .Open
    End With
    
    Set rs = cn.Execute(strSQL)
For ctr = 0 To item
        rs.AddNew
        rs.Fields("Status") = "In Process"
        rs.Fields("PR#") = pr_array(1, item) 'PR#
        rs.Fields("Approved Date") = pr_array(2, item)      'PR Date
        rs.Fields("Line Description") = pr_array(3, item)        ' line description
        rs.Fields("T1") = pr_array(4, item)       'T1
        rs.Fields("T2") = pr_array(5, item)       'T2
        rs.Fields("T3") = pr_array(6, item)       'T3
        rs.Fields("Account Code") = pr_array(7, item)       'Acc Code
        rs.Fields("Estimated Unit Cost") = pr_array(8, item)      'eup
        rs.Fields("QTY") = pr_array(9, item)      'QTY
        rs.Fields("Unit") = pr_array(10, item)      'UNITS
        rs.Fields("Total Estimate Cost") = pr_array(11, item)   'QTY
Next ctr
    rs.Update


    rs.Close
'    Db.Close


    'destroy the variables
    Set rs = Nothing
'    Set Db = Nothing


End Sub

 

[ChrisM]

You're not setting any of the critical recordset properties before you open it.

With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FilePath & FileName & ";" & _
            "Extended Properties=Excel 12.0;"
        .Open
End With

With rs
   .LockType = adLockOptimistic
   .CursorType = adOpenKeyset
End With
    
Set rs = cn.Execute(strSQL)

If you don't specify those settings it will default to a read-only recordset.

Also, move your .Update inside your loop. You can't store up a bunch of changes and use Update, that's what UpdateBatch is for (which has it's own set of issues, just use Update one record at a time).

For ctr = 0 To item
        rs.AddNew
        rs.Fields("Status") = "In Process"
        rs.Fields("PR#") = pr_array(1, item) 'PR#
        rs.Fields("Approved Date") = pr_array(2, item)      'PR Date
        rs.Fields("Line Description") = pr_array(3, item)        ' line description
        rs.Fields("T1") = pr_array(4, item)       'T1
        rs.Fields("T2") = pr_array(5, item)       'T2
        rs.Fields("T3") = pr_array(6, item)       'T3
        rs.Fields("Account Code") = pr_array(7, item)       'Acc Code
        rs.Fields("Estimated Unit Cost") = pr_array(8, item)      'eup
        rs.Fields("QTY") = pr_array(9, item)      'QTY
        rs.Fields("Unit") = pr_array(10, item)      'UNITS
        rs.Fields("Total Estimate Cost") = pr_array(11, item)   'QTY

       .rs.Update
Next ctr

 

[switters_aka]

Thanks ChrisM. That makes sense and did the trick. Still learning about recordset handling. Cheers!