Add list item to sharepoint list using vba - vba

Question

Im trying to create an excel tool that will add list item to sharepoint custom list. I had theinitial code but i am getying an error "couldnt find installable ISAM". My excel is 2016 and running in windows 10. How can i fix this issue?
Public Const sDEMAND_ROLE_GUID As String = "{6AA0B273-2548-49ED-9592-78243D4353AC}"
Public Const sSHAREPOINT_SITE As String = "https://eu001-sp.domain.com/sites/"
Sub TestPullFromSharepoint()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConn As String
Dim sSQL As String
Dim ID As String
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;DATABASE=" & sSHAREPOINT_SITE & ";" & _
"LIST=" & sDEMAND_ROLE_GUID & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=1;';"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
With cn
.ConnectionString = sConn
.Open
End With
sSQL = "SELECT tbl.[name] FROM [Library Name] as tbl where tbl.[id] = 14"
rs.Open sSQL, cn, adOpenStatic, adLockOptimistic
End Sub

Answer 1

I know it isn't super pretty, but I have a solution... Make sure that you replace YOURSHAREPOINTSITE with the url of your site.
The beauty of my solution, is that the code allows for:
Creation of new SP list
Addition of list items with all original column of the list
Addition of list items with any number of columns of the list (as
long as all required columns are represented)
No link required for the addition of new data (does create a link
when you use #1 but not a syncing link)
Limitations:
Column validation will cause a failed run if you pass data that
shouldn't go in that column (text to number column)
Absent required columns cause a failed run
Untested with lookup, people/group, or other record related column
types... but it would cause invalid data, potentially a failed run
unless you input the ID of the lookup value... which you probably
don't have.
It does require correct typing of column names and list name in
input boxes...
Public Sub PushSPList()
Dim lname As String, guid As String
Dim arr, arrr
Dim NewList As ListObject
Dim L As ListObjects
' Get the collection of lists for the active sheet
Set L = ThisWorkbook.ActiveSheet.ListObjects
' Add a new list
If MsgBox("Have you selected the new data?", vbYesNo) = vbNo Then
Exit Sub
Else
If MsgBox("New?", vbYesNo) = vbYes Then
lname = InputBox("What is the name of your new list?")
Set NewList = L.Add(xlSrcRange, Selection, , xlYes, True)
NewList.Name = lname
' Publish it to a SharePoint site
NewList.Publish Array("https://YOURSHAREPOINTSITE", lname), False
Else
arr = getSPitems
lname = arr(2)
guid = arr(1)
Set NewList = L(1)
Set arrr = Selection
Call addSPListItem(arrr, lname, guid)
End If
End If
End Sub
Sub addSPListItem(rar As Variant, lnme, guid)
Dim arr, lguid As String, spurl As String, lname As String, uitem As Object
lguid = guid
lname = lnme
spurl = "https://YOURSHAREPOINTSITE"
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset 'tb
Dim mySQL As String
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
mySQL = "SELECT * FROM [" & lname & "];"
With cnt
.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;" & _
"DATABASE=" & spurl & _
";LIST=" & lguid & ";"
.Open
End With
rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic
Dim fld As Object
Dim arrr()
i = -1
For Each fld In rst.Fields
i = i + 1
ReDim Preserve arrr(0 To i)
arrr(i) = rst.Fields(i).Name
Next
Dim clmns
clmns = Split(InputBox("Select columns, separated by commas, no spaces after commas... " & Join(arrr, ", ")), ",")
Dim Colmns As Object
Set Colmns = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(clmns)
Colmns(i) = clmns(i)
Next
jj = 1
Do While rar(jj, 1) ""
rst.AddNew
For kk = 0 To UBound(clmns)
rst.Fields(Colmns(kk)) = rar(jj, kk + 1)
Next
jj = jj + 1
Loop
rst.Update
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
MsgBox "Done"
End Sub