Sharepoint 上 Excel 的 ADO 连接

Question

我使用宏代码构建了一个 Excel 文件，该文件可以访问其自己的工作表之一上的大量数据。我使用 ADO 连接，以便可以对数据使用 SQL。这在我的本地计算机上运行良好。当我将文件移动到网络驱动器时，执行连接的代码行出现错误。我的连接字符串是由 ThisWorkbook.FullName 组成的，现在该文件位于看起来像 url 的共享点驱动器上。

https://mycompany.sharepoint.com/sites/directoryPath/file.xlsm

我认为要么是这个网址有问题，要么与网络凭据有关。如果有一种方法可以跳过这个，只告诉 excel '嘿，您只是访问已打开的同一文件中的另一个工作表'，那就更容易了......但我不知道该怎么做。这是我的代码（谢谢！）：

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

strFile = ThisWorkbook.FullName

strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
  & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon

Answer 1

这里是创建本地副本的示例（假设查询的数据是静态的）

针对工作表的第一次查询相对较慢，但后续查询会快得多。

Sub Tester()
    Dim rs As ADODB.Recordset
    
    With ThisWorkbook.Worksheets("Sheet1")
        .UsedRange.Clear
        
        Set rs = RunSQL("select * from [Sheet2$]", ThisWorkbook.Worksheets("Sheet2"))
        ThisWorkbook.Worksheets("Sheet1").Range("A2").CopyFromRecordset rs
        
        Set rs = RunSQL("select * from [Sheet3$]", ThisWorkbook.Worksheets("Sheet3"))
        ThisWorkbook.Worksheets("Sheet1").Range("J2").CopyFromRecordset rs
        
    End With
    
End Sub

'Run some sql against a worksheet (using locally-saved copy)
Function RunSQL(sql As String, ws As Worksheet) As ADODB.Recordset
    Dim rs As ADODB.Recordset
    Dim cn As ADODB.Connection 'cache once created
    Set cn = LocalSheetConnection(ws)
    Set RunSQL = cn.Execute(sql)
End Function

Function LocalSheetConnection(ws As Worksheet) As ADODB.Connection
    Dim cn As ADODB.Connection, wb As Workbook, TempPath As String
    Static PathDict As Object 'cache local path
    If PathDict Is Nothing Then Set PathDict = CreateObject("Scripting.Dictionary")
    If Not PathDict.Exists(ws.Name) Then 'create local copy if not already created
        Application.ScreenUpdating = False
        ws.Copy                  'copy to new workbook and save
        Set wb = ActiveWorkbook
        TempPath = GetTempPath()
        wb.SaveAs TempPath, FileFormat:=xlOpenXMLWorkbook
        wb.Close False
        Application.ScreenUpdating = True
        PathDict.Add ws.Name, TempPath 'cache path with sheet name as key
    End If
    Set LocalSheetConnection = CreateObject("ADODB.Connection")
    LocalSheetConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                PathDict(ws.Name) & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
End Function

Function GetTempPath() As String
    With CreateObject("scripting.filesystemobject")
        '2=TempFolder
        GetTempPath = .GetSpecialFolder(2) & "\" & .GetTempName() & ".xlsx"
    End With
End Function