使用 ADODB 连接打开作为数据源存储在 SharePoint 上的 Excel 个文件

Question

我正在尝试使用以下 VBA 代码片段打开一个 Excel 文件作为数据源：

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
With cn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=" & path & "\" & VFile & ";" & _
        "Extended Properties=""Excel 8.0; HDR=No; IMEX=1;"""
    .Open
End With

当 path 变量的类型为 C:\Folder 时，这会按预期工作。但是，如果我想引用与当前文件位于同一文件夹中的 excel 文件，并使用

path = ThisWorkbook.path

当前工作簿位于存储在 SharePoint 上的文件夹中，path 将包含以下形式的内容

https://sp.foobar.com/folder

尝试使用此路径进行连接会导致 Method 'Open' failed 错误。将路径修改为 WebDAV 路径告诉我该文件已被锁定或我没有读取它的权限。

有人能帮忙吗？

当我手动将path设置为Drive:\Folder形式时，一切正常，但如果文件存储在SharePoint，我希望解决方案是 'portable'，只要所有相关文件都在同一个文件夹中，就可以在驱动器上的任何地方工作。

Answer 1

连接到 Sharepoint 上的 excel 文件时，您必须更改路径中的一些细节。具体来说，删除开头的 "http:"，将“\”替换为“/”，并将所有空格替换为“%20”。

以下 VBA 代码检查文件路径是否包含 "http"，如果包含则执行上述替换和 returns ADODB 可以读取的字符串 (ExcelWorkbook)。

If InStr(ThisWorkbook.FullName, "http:") = 0 Then ExcelWorkbook = ThisWorkbook.FullName Else ExcelWorkbook = Replace(Replace(Replace(ThisWorkbook.FullName, "/", "\"), " ", "%20"), "http:", "")

我不知道为什么在进行此更改时会起作用，但它确实起作用了！

Answer 2

这不再有效，但我找到了解决此问题的方法。 Sharepoint 库到本地挂载点的分配存储在注册表中，以下函数会将 URL 转换为本地文件名：

Public Function GetLocalFile(wb As Workbook) As String
    Const HKEY_CURRENT_USER = &H80000001
    Dim temp As Object
    Dim rPath As String
    Dim arrSubKeys() As Variant
    Dim strAsk As Variant
    Dim strValue As String
    Dim strMountpoint As String

    Set temp = GetObject("winmgmts:{impersonationLevel=impersonate}!\.\root\default:StdRegProv")

    rPath = "Software\SyncEngines\Providers\OneDrive\"
    temp.EnumKey HKEY_CURRENT_USER, rPath, arrSubKeys
    For Each strAsk In arrSubKeys
        temp.getStringValue HKEY_CURRENT_USER, rPath & strAsk, "UrlNamespace", strValue
        If InStr(wb.FullName, strValue) > 0 Then
            temp.getStringValue HKEY_CURRENT_USER, rPath & strAsk, "MountPoint", strMountpoint
            GetLocalFile = strMountpoint & "\" & Replace(Right(wb.FullName, Len(wb.FullName) - Len(strValue)), "/", "\")
            Exit Function
        End If
    Next
    GetLocalFile = wb.FullName
End Function

Answer 3

截至 2021 年 11 月，此代码适用于我的案例。假设您有一个名为“PATHS”的 sheet 和一个包含“零售商”字段的 table。

Private Sub ConnectToDatabase()

'VERY VERY IMPORTANT: FILE NEEDS TO BE SAVED FOR ADO TO DETECT CHANGES. ANY CHANGES WITH NO SAVE WILL NOT BE REFLECTED <<<<<<<<<<<<<<<<<

'ESTABLISH ADO CONNECTION
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

StrFile = Convert_HTTP_To_NetworkPath(ThisWorkbook.FullName) 
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & StrFile & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set DATABASE = CreateObject("ADODB.Connection")
Set RST = CreateObject("ADODB.Recordset")

DATABASE.Open strCon
'UserForm4.Hide


'FOR TESTING ONLY
TEST_CONNECTION = True
If TEST_CONNECTION = True Then
    SQL = "SELECT * FROM [PATHS$]"
    RST.Open SQL, DATABASE, adOpenStatic, adLockReadOnly
        RST.MoveLast
        Result = MsgBox(RST.Fields("RETAILER"), vbInformation)
    RST.Close
End If

End Sub



Function Convert_HTTP_To_NetworkPath(URL)
    
    Result = URL
    Result = Replace(Result, "%20", " ")
    Result = Replace(Result, "https://mycompany.sharepoint.com", "\mycompany.sharepoint.com@SSL\DavWWWRoot")
    Result = Replace(Result, "/", "\")
    If IsIn(".", Right(Result, 5)) = False And Right(Result, 1) <> "\" Then Result = Result & "\"
    Convert_HTTP_To_NetworkPath = Result
    
End Function

Function IsIn(Keyword, Text)

    If UCase(Text) Like "*" & UCase(Keyword) & "*" Then IsIn = True Else IsIn = False
    
End Function

使用 ADODB 连接打开作为数据源存储在 SharePoint 上的 Excel 个文件

Opening Excel file stored on SharePoint as data source using ADODB Connection

excel

sharepoint

adodb