VBA update sharepoint inserts

I think I'm almost there. Except the update is inserting into sharepoint.
Using Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0. See code below.

Situation:
I'm refreshing in an excel table from a power query a Sharepoint list (Sharepoint server 2016).
So far so good. One of the columns can be changed. These changes need to be send to the same Sharepoint list.

First I tried the easy way:

*

Dim objListObj As ListObject
    Dim ws As Worksheet
    Set ws = Worksheets("DCS")
    'Set objListObj = Sheets("DCS").ListObjects(1)
    Set objListObj = ws.ListObjects(1)
    objListObj.UpdateChanges xlListConflictDialog

====================
Error msg: Application or object defined error.
No clue why this error, but secondly I trie to loop through the table (by converting to array)

I'm aware for updating we need IMEX=0.
So I wonder since sharepoint doesn't work with a primary key. So how this update can work....
I tried to collect all the values and subsequently update this to Sharepoint. The VLookup is because I need the ID in another table.

Debugging shows me all data is collected fine.
Also tried opening connection once instead of in every loop like it is now. But then I see the inserts ariving in the sharepoint list and at the end all inserts are gone.

Result: A new record is INSERTED with the changed values....
The actual update is done in line "rst.Update". But this doesn't update, but insert instead.

So question is how to UPDATE a record, since there is no PK.
I also don't understand very well the purpose of the mySQL. It doesn't matter how this is defnied.

Code:

Option Explicit
Sub UpdateKPIMember_SP()
    Dim cnt As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim mySQL As String
    
    Set cnt = New ADODB.Connection
    Set rst = New ADODB.Recordset
    
    Dim RNG As Range
    Dim aCell As Range
    Dim myTable As ListObject
    Dim myArray As Variant
    Dim x As Long
    
    'Set path for Table variable
    Set myTable = Sheets("DCS").ListObjects("KPIMember")
    'Create Array List from Table
    myArray = myTable.DataBodyRange
    'Loop through each item of Table (displayed in Immediate Window [ctrl + g])
    For x = LBound(myArray) To UBound(myArray)
          Debug.Print myArray(x, 2) & "     " & myArray(x, 3) & "     " & myArray(x, 6)
        With cnt
            .ConnectionString = _
            "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=https://someSPsite.com/business/88247;LIST={3b96ef03-64e6-4ae6-9599-a1e6ef66f17f};"
            .Open
        End With
        mySQL = "SELECT * FROM OBH_KPIMember where DCS_EmplID = '" & Sheets("Control").Range("O8") & "';"
        Debug.Print mySQL
        rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic
          If Not (rst.BOF And rst.EOF) Then
                rst.Fields("CurrentWeek") = Sheets("Control").Range("D9")
                rst.Fields("KPI_ID") = CStr(Application.WorksheetFunction.VLookup(myArray(x, 3), Sheets("OBH_KPIDATA").ListObjects("OBH_KPIDataID").DataBodyRange, 2, 0))
                rst.Fields("DCS_EmplID") = Application.WorksheetFunction.VLookup(Worksheets("Voorblad").ComboBox1.Value, Sheets("DCS_LIST").ListObjects("OBH_MemberData__5").DataBodyRange, 2, 0)
                rst.Fields("Member_EmplID") = myArray(x, 2)
                rst.Fields("Member_Name") = myArray(x, 1)
                rst.Fields("Comment") = myArray(x, 6)
                rst.Update
          End If
        If CBool(rst.State And adStateOpen) = True Then rst.Close
        Set rst = Nothing
        If CBool(cnt.State And adStateOpen) = True Then cnt.Close
        Set cnt = Nothing
    Next x
    

MsgBox "Your data for period " + CStr(Sheets("Control").Range("D8")) + " is submitted"

End Sub

3 answers

Hello Dinos,

command: rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic takes data from mySQL querry (this only select data - don't do any update).

For update record use:

"UPDATE OBH_KPIMember SET field1=field1 new value,field2=field2 new value, ... WHERE DCS_EmplID =Id _updating_record '/or diffrent conditions"

For insert new record:

"INSERT INTO OBH_KPIMember ()
VALUES(
new value1, new value2,...)"

For update or insert new data use: cnt.execute(mySQL) not rs.open mySQL,...

Your mySQL update querry should looks like this:

mySQL=
"UPDATE OBH_KPIMember
SET CurrentWeek='X1X'
,KPI_ID=X2X
,DCS_EmplID=X3X
,Member_EmplID=X4X
,Member_Name='X5X'
,Comment='X6X'
WHERE DCS_EmplID =X0X"

mySQL=Replace(mySQL,"X0X",cstr(Sheets("Control").Range("O8")))
mySQL=Replace(mySQL,"X1X",cstr(Sheets("Control").Range("D9")))
....

cnt.execute(mySQL) '- update record / (records with conditions)

Hi Krysztof,

It seems to work (at a first challence)
This solution means that I even don't need the rst ADODB.Recordset definition. Just ADODB.Connection fits.

If Not (rst.BOF And rst.EOF) Then
...
End If

That makes life easier. Thanks a lot!
Final working code below.

Any idea how to improve performance?

Option Explicit
Sub Upd2KPIMember_SP()
    Dim cnt As ADODB.Connection
    Dim mySQL As String
    Dim RNG As Range
    Dim aCell As Range
    Dim myTable As ListObject
    Dim myArray As Variant
    Dim Member_Name, Member_EmplID, KPI_ID, Comment As String
    Dim x As Long
    
    Set cnt = New ADODB.Connection
    With cnt
        .ConnectionString = _
        "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=https://www.someSPsite.com;LIST={3b96ef03-64e6-4ae6-9599-a1e6ef66f17f};"
        .Open
    End With
    'Set path for Table variable
    Set myTable = Sheets("DCS").ListObjects("KPIMember")
    'Create Array List from Table
    myArray = myTable.DataBodyRange
    'Loop through each item in Third Column of Table (displayed in Immediate Window [ctrl + g])
    For x = LBound(myArray) To UBound(myArray)
          Member_Name = myArray(x, 1)
          Member_EmplID = myArray(x, 2)
          Comment = myArray(x, 6)
          KPI_ID = CStr(Application.WorksheetFunction.VLookup(myArray(x, 3), Sheets("OBH_KPIDATA").ListObjects("OBH_KPIDataID").DataBodyRange, 2, 0))
          'emplID lkp: Application.WorksheetFunction.VLookup(Worksheets("Voorblad").ComboBox1.Value, Sheets("DCS_LIST").ListObjects("OBH_MemberData__5").DataBodyRange, 2, 0)
          Comment = myArray(x, 6)
        ' mySQL = "SELECT * FROM OBH_KPIMember where DCS_EmplID = '" & Sheets("Control").Range("O8") & "';"
        mySQL = "UPDATE OBH_KPIMember SET Comment='" & Comment & "' where DCS_EmplID = '" & Sheets("Control").Range("O8") & "' AND KPI_ID=" & KPI_ID & " AND Member_EmplID='" & Member_EmplID & "';"
         Debug.Print mySQL
        cnt.Execute (mySQL)
    Next x
    If CBool(cnt.State And adStateOpen) = True Then cnt.Close
    Set cnt = Nothing