Question

我正在尝试创建一个将列表项添加到sharepoint自定义列表的Excel工具。我有初始代码，但我发现错误＆＃34;无法找到可安装的ISAM＆＃34;。我的excel是2016年，在Windows 10中运行。我该如何解决这个问题？

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

我知道它不是很漂亮，但是我有一个解决方案...请确保您用网站的网址替换YOURSHAREPOINTSITE。

我的解决方案的优点在于代码允许：

创建新的SP列表
添加具有列表所有原始列的列表项
添加具有任意列数的列表项（如只要代表了所有必填列）
添加新数据不需要链接（创建链接）当您使用＃1但未使用同步链接时

限制：

如果传递的数据列验证将导致运行失败不应进入该列（文本到数字列）
缺少必填列会导致运行失败
未经测试的查找，人员/组或其他与记录相关的列类型...但是会导致无效数据，可能会导致运行失败除非您输入查找值的ID ...您可能没有。
它确实要求在其中正确输入列名和列表名输入框...

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

使用vba将列表项添加到sharepoint列表

1 个答案: