使用同步 OneDrive 文件夹中的 Excel 工作簿作为 ADODB 连接的 ODBC 锁定错误

Question

我在同步的 OneDrive for Business 文件夹中有一个 Excel 工作簿，我想将其用作 ADODB 连接的数据源，该连接是从工作簿本身的代码中调用的。

当我尝试建立连接时，VBA 抛出错误。

-2147467259

用于 ODBC 驱动程序的 Microsoft OLE DB 提供程序

[Microsoft][ODBC Excel 驱动程序]一般错误无法打开注册表项 Temporary (volatile) Ace DSN for process 0x17e0 Thread 0x3cd4 DBC 0x920bf1c Excel'。

如果文件位于未同步的文件夹中，则不会发生错误，例如我的文档。

我只需要对连接进行只读访问。我可以用不同的方式形成连接字符串吗？

我尝试了一个不同的连接字符串，我尝试将其设为只读 (Mode=Read)：

cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read; _
Data Source=" & ActiveWorkbook.Path & Application.PathSeparator & _
ActiveWorkbook.Name & "; Extended Properties=""Excel 12.0 Macro;HDR=YES"";"

我得到一个不同的错误：

-2147467259

Microsoft Access 数据库引擎

无法更新。数据库或对象是只读的。

Sub TestExcelADODB()
    Dim cnx As New ADODB.Connection
    Set cnx = OpenExcelConnection(ActiveWorkbook.Path, ActiveWorkbook.Name)
    cn.Close
End Sub

错误发生在cn.Open:

Public Function OpenExcelConnection(Path As String, File As String) _
  As ADODB.Connection
    Dim cn As New ADODB.Connection
    If cn.State = adStateOpen Then cn.Close
    cn.ConnectionString = "Driver={Microsoft Excel Driver _
      (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
      Path & Application.PathSeparator & File
    cn.Open
    Set OpenExcelConnection = cn
End Function

Answer 1

我找到了解决方案：指向本地文件而不是远程位置。为此，有一个简单的字符串替换函数，它通过查询环境变量来查找本地文件路径（这些变量告诉系统 OneDrive 文件的存储位置）。

我稍微修改了代码，因为对我来说真正的位置似乎包括“onedrive.”，它不在原始代码中。

这是完整的代码：

Private Function getLocalFullName$(ByVal fullPath$)
    'Finds local path for a OneDrive file URL, using environment variables of OneDrive
    'Reference https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive
    'Authors: Philip Swannell 2019-01-14, MatChrupczalski 2019-05-19, Horoman 2020-03-29, P.G.Schild 2020-04-02

    Dim ii&
    Dim iPos&
    Dim oneDrivePath$
    Dim endFilePath$

    If Left(fullPath, 8) = "https://" Then 'Possibly a OneDrive URL
        If InStr(1, fullPath, "my.sharepoint.com") <> 0 Or InStr(1, fullPath, "https://onedrive.") <> 0 Then 'Commercial OneDrive
            'For commercial OneDrive, path looks like
            ' "https://companyName-my.sharepoint.com/personal/userName_domain_com/Documents" & file.FullName)
            'Find "/Documents" in string and replace everything before the end with OneDrive local path
            iPos = InStr(1, fullPath, "/Documents") + Len("/Documents") 'find "/Documents" position in file URL
            endFilePath = Mid(fullPath, iPos) 'Get the ending file path without pointer in OneDrive. Include leading "/"
        Else 'Personal OneDrive
            'For personal OneDrive, path looks like "https://d.docs.live.net/d7bbaa#######1/" & file.FullName
            'We can get local file path by replacing "https.." up to the 4th slash, with the OneDrive local path obtained from registry
            iPos = 8 'Last slash in https://
            For ii = 1 To 2
                iPos = InStr(iPos + 1, fullPath, "/") 'find 4th slash
            Next ii
            endFilePath = Mid(fullPath, iPos) 'Get the ending file path without OneDrive root. Include leading "/"
        End If
        endFilePath = Replace(endFilePath, "/", Application.PathSeparator) 'Replace forward slashes with back slashes (URL type to Windows type)
        
        'getLocalFullName = getLocalOneDrivePath & endFilePath
        
        For ii = 1 To 3 'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
            oneDrivePath = Environ(Choose(ii, "OneDriveCommercial", "OneDriveConsumer", "OneDrive")) 'Check possible local paths. "OneDrive" should be the last one
            If 0 < Len(oneDrivePath) Then
                getLocalFullName = oneDrivePath & endFilePath
                Exit Function 'Success (i.e. found the correct Environ parameter)
            End If
        Next ii
        'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
        getLocalFullName = vbNullString
    Else
        getLocalFullName = fullPath
    End If
End Function