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
0
edit delete
are you sure?
asked The Dinos

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)

0
edit delete
are you sure?
answered Krysztof Spaliński

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
0
edit delete
are you sure?
answered The Dinos

I will try later do some improvement in your code in free time :)

0
edit delete
are you sure?
answered Krysztof Spaliński

Post an answer but please log in first

Post Answer
  1. Please log in to post answer

Similar Questions

Tagsfor this question

Forumall questions