通过Excel VBA删除Sharepoint列表的全部内容

Question

因此，我在 Excel 中创建了一个类，用于管理与 SharePoint 列表的连接并返回记录集或执行 SQL。

下面是该代码：

Option Explicit

'***********************************************************************************
'SharepointListClass helps hold SQL code and gives convenient functions to call that SQL code.
'Requires Reference: Microsoft ActiveX Data Objects x.x Library
'***********************************************************************************

Private zLines As New Collection
Private zConnection As ADODB.Connection

Public Sub Add(ByVal sqlLine As String)

'**************************************************************************************
'    DESCRIPTION:
'       This will add a line of SQL as a string to the collection
'
'    INPUT VARS:
'       sqlLine: The string of SQL code to add to the bottom of the collection
'**************************************************************************************

    Dim addSql As String: addSql = sqlLine
    'Makes sure that the right is always a space since this will not hold SQL code with new paragraphs.
    If VBA.Right(addSql, 1) <> " " Then
        addSql = addSql & " "
    End If

    zLines.Add addSql

End Sub

Public Sub Blank()

'**************************************************************************************
'    DESCRIPTION:
'       This will add a element to the collection that contains a vbnullstring. This
'       only helps when trying to view the code in a readable form (printsql)
'
'    INPUT VARS:
'       n/a
'**************************************************************************************

    zLines.Add vbNullString

End Sub

Public Sub Clear()

'**************************************************************************************
'    DESCRIPTION:
'       This will clear all code from the collection
'
'    INPUT VARS:
'       n/a
'**************************************************************************************

    Set zLines = New Collection

End Sub

Public Function Code() As String

'**************************************************************************************
'    DESCRIPTION:
'       This returns a string showing the full SQL code held within this Class instance.
'       NO PARAGRAPHS SHOWN
'
'    INPUT VARS:
'       n/a
'**************************************************************************************

    Dim str As String

    Dim i As Integer
    For i = 1 To zLines.Count
        str = str & zLines(i)
    Next

    'Remove double spaces, to reduce size of string
    Do Until InStr(str, "  ") = 0
        str = Replace(str, "  ", " ")
    Loop

    'Excel can only send a query to the SQL Server of 32,767 or less, this will throw an error on purpose so you know this is what cause the issue.
    If Len(str) > 32767 Then
        Dim xxx As Integer: xxx = 1000000 'errors on purpose
    End If

    Code = str

End Function

Public Sub PrintSql()

'**************************************************************************************
'    DESCRIPTION:
'       Prints SQL code in the Immediate Window, this will show each line as a new line
'       For debug purposes
'
'    INPUT VARS:
'       n/a
'**************************************************************************************

    Dim i As Integer
    For i = 1 To zLines.Count
        Debug.Print zLines(i)
    Next

End Sub

Public Sub OpenConnection(SharepointSite As String, ListName As String)

'**************************************************************************************
'   DESCRIPTION:
'       Opens a connection to the SQL server and database to have Code run off of it
'
'   INPUT VARS:
'       DataSource:   The address of the SQL Server
'       DatabaseName: The database name within the server
'**************************************************************************************

    If zConnection Is Nothing Then Set zConnection = New ADODB.Connection

    Debug.Print "Sharepoint reconnected"
    zConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                   "WSS;" & _
                                   "IMEX=0;" & _
                                   "RetrieveIds=Yes;" & _
                                   "DATABASE=" & SharepointSite & ";" & _
                                   "LIST=" & ListName & ";"

    zConnection.Open

End Sub

Public Sub CheckConnection()

'**************************************************************************************
'   DESCRIPTION:
'       Checks if the connection object exists and creates it if not. Also checks if the
'       database is conenected, if not connects it.
'
'   INPUT VARS:
'       n/a
'**************************************************************************************

    If zConnection Is Nothing Then Set zConnection = New ADODB.Connection

    If zConnection.State <> adStateOpen Then
        OpenConnection SharepointSite:="https://<Sharepoint address>/", _
                       ListName:="lstQuoteWinLoss"
    End If

End Sub

Public Sub CloseConnection()

'**************************************************************************************
'   DESCRIPTION:
'       Closes the connection made by OpenConnection
'
'   INPUT VARS:
'       n/a
'**************************************************************************************

    zConnection.Close

End Sub

Public Sub SetConnection(conn As ADODB.Connection)

    Set zConnection = conn

End Sub

Public Function GetQueryRecordset() As ADODB.Recordset

'**************************************************************************************
'   DESCRIPTION:
'       This will create an ADODB.recordset from the SQL code and server and return it
'       as a recordset object.
'
'   INPUT VARS:
'       n/a
'**************************************************************************************

    On Error GoTo FUNC_ERR

    Dim t As Integer: t = 1

GET_RST:
    Dim rst As New ADODB.Recordset
    CheckConnection
    Set rst.ActiveConnection = zConnection
    rst.Source = Me.Code
    rst.Open

    Set GetQueryRecordset = rst

FUNC_EXIT:
    Exit Function

FUNC_ERR:
    If Error = -2147217871 And t < 5 Then
        t = t + 1
        GoTo GET_RST
    Else
        MsgBox "Error Numuber: " & Err.Number & vbLf & Err.Description
        End
    End If

End Function

Public Sub Execute()

    zConnection.Execute Code

End Sub

然后我在代码中使用它，如下所示

Dim spSQL As New SharepointListClass
With spSQL
    .OpenConnection SharepointSite:="https://<Sharepoint address>/", ListName:="lstQuoteWinLoss"
    .Add "DELETE FROM lstQuoteWinLoss"
    .Execute
End With

一切似乎都工作正常，但我希望能够清除该 SharePoint 列表，然后用新数据填充它。但是，我在这样做时遇到了问题。

如果我使用像 DELETE FROM tblQuoteWinLoss 这样的普通 SQL 语句，它确实会开始删除行，但是，它似乎一次删除一行，需要非常长的时间。我可以在 SharePoint 网站上点击刷新，然后看到数字在减少。另外，由于某种原因，它似乎会自己绊倒并每隔 25 到 30 秒抛出此错误。如果我只是选择“调试”并点击“播放”按钮，它会执行更多操作，然后再次抛出错误。

经过一番谷歌搜索后，我偶然发现了另一个功能，该功能应该可以快速清除表 TRUNCATE TABLE lstQuoteWinLoss。但是，SharePoint 或我用来通过 VBA 执行代码的方法似乎都不支持这一点。

所以我的问题是，有谁知道我可以用来快速清除表格以便我可以将新项目添加回其中的方法吗？谢谢！

- -编辑 - - 经过一些测试，它似乎在抛出只读错误之前删除了 100 行，这似乎是这里发生了其他事情。有什么想法吗？