How to Connection String to Sharepoint 2013 Internet Vba

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                              

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

How to Connection String to Sharepoint 2013 Internet Vba

Source: https://www.connectionstrings.com/questions/100002/vba-update-sharepoint-inserts/

Share this post