如何让我的 VBA 项目引用 OneDrive 上的 Excel 工作簿以使用本地驱动器路径而不是 OneDrve URL 路径?

How do I get my VBA project reference to an Excel Workbook on OneDrive to use the local drive path rather than the OneDrve URL Path?

2021-03-20 更新:我发现即使我将我想要引用的文件从我的 OneDrive 复制到不属于 OneDrive 的本地文件夹,并引用它,也会发生同样的事情.只有在我也重命名该文件后,我才能引用它,而无需将其路径变成 URL(假设指向我的在线 OneDrive)。这不符合我的需要。我正在尝试找到一种方法来在不同设备上的不同位置的不同应用程序之间共享我的 VBA 代码库。如果我不明白这一点,我可能会就此创建一个单独的问题。

原问题: 当我向存储在 OneDrive 本地副本上的 Excel xlsm 文件添加引用(在 VBA,工具 -> 引用中)时,路径被转换为 url 和我无法再加载我的 VBA 项目而不会收到找不到文件的错误。如何使引用始终指向我本地同步的 OneDrive 路径?

例如,

  1. 打开一个 xlsm 项目

  2. 打开VBA IDE

  3. Select 工具 -> VBIDE 菜单中的参考文献

  4. 浏览以添加对另一个 xlsm 文件的引用。
    一种。例如,C:\Users\Andbio\OneDrive\Code Libraries\RYTEwayCode (XLSM).xlsm

    b。确保在打开的“添加引用”文件打开对话框中输入 xlsm select。

    c。 select 您要引用的 xlsm 文件并单击“打开”。

    d.请注意,在“引用”对话框底部的“位置:”字段中,它显示了本地路径。

  5. 单击“确定”将新引用添加到项目。

至此,一切正常,您可以执行刚才引用的文件中的代码。所以,参考作品。

  1. Select 工具 -> 参考资料,再次来自 VBIDE 菜单
  2. Select 您刚刚添加的引用。
  3. 请注意,现在,在“位置:”字段中,您引用的文件的本地路径已替换为 URL。在我的例子中,它现在说:“https://d.docs.live.net/8e13263ac9cf0594/Code Libraries/RYTEwayCode (XLSM).xlsm”.

如果我现在保存并关闭 XLSM 文件,然后尝试重新打开它,我会收到一条错误消息,提示它无法在上面第 8 步中显示的 URL 路径中找到该文件。我不得不在安全模式 (/s) 中重新打开它以再次打开文件以删除引用。

我知道为什么会这样,也知道为什么要这样设计,如果有的话,我只需要一种方法来解决它。是否仍然能够将我的引用文件存储在 OneDrive 上,而不是将我的 XLSM 文件存储在同一个 OneDrive 上?

当您添加对 XLSM 文件的引用时,VBA 基本上会像使用“打开文件”命令一样打开工作簿。因此,您可以做的是在触发第一个工作簿的 Open 事件时打开第二个工作簿。如果工作簿保存在 OneDrive 文件夹中,您可能会发现使用 ThisWorkbook.Path 获取工作簿的物理路径时出现问题。我有一个辅助函数也可以帮助您。看看:

Private Sub Workbook_Open()
    
    Workbooks.Open GetWorkbookPath & "\RYTEwayCode (XLSM).xlsm"
    
End Sub

您还需要 GetWorkbookPath 函数。

Function GetWorkbookPath(Optional wb As Workbook)
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' Purpose:  Returns a workbook's physical path, even when they are saved in
    '           synced OneDrive Personal, OneDrive Business or Microsoft Teams folders.
    '           If no value is provided for wb, it's set to ThisWorkbook object instead.
    ' Author:   Ricardo Gerbaudo
    ' Source:   https://github.com/ricardogerbaudo/vba-helpers
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    If wb Is Nothing Then Set wb = ThisWorkbook
    
    GetWorkbookPath = wb.Path
    
    If InStr(1, wb.Path, "https://") <> 0 Then
        
        Const HKEY_CURRENT_USER = &H80000001
        Dim objRegistryProvider As Object
        Dim strRegistryPath As String
        Dim arrSubKeys()
        Dim strSubKey As Variant
        Dim strUrlNamespace As String
        Dim strMountPoint As String
        Dim strLocalPath As String
        Dim strRemainderPath As String
        Dim strLibraryType As String
    
        Set objRegistryProvider = GetObject("winmgmts:{impersonationLevel=impersonate}!\.\root\default:StdRegProv")
    
        strRegistryPath = "SOFTWARE\SyncEngines\Providers\OneDrive"
        objRegistryProvider.EnumKey HKEY_CURRENT_USER, strRegistryPath, arrSubKeys
        
        For Each strSubKey In arrSubKeys
            objRegistryProvider.GetStringValue HKEY_CURRENT_USER, strRegistryPath & "\" & strSubKey & "\", "UrlNamespace", strUrlNamespace
            If InStr(1, wb.Path, strUrlNamespace) <> 0 Or InStr(1, strUrlNamespace, wb.Path) <> 0 Then
                objRegistryProvider.GetStringValue HKEY_CURRENT_USER, strRegistryPath & "\" & strSubKey & "\", "MountPoint", strMountPoint
                objRegistryProvider.GetStringValue HKEY_CURRENT_USER, strRegistryPath & "\" & strSubKey & "\", "LibraryType", strLibraryType
                
                If InStr(1, wb.Path, strUrlNamespace) <> 0 Then
                    strRemainderPath = Replace(wb.Path, strUrlNamespace, vbNullString)
                Else
                    GetWorkbookPath = strMountPoint
                    Exit Function
                End If
                
                'If OneDrive Personal, skips the GUID part of the URL to match with physical path
                If InStr(1, strUrlNamespace, "https://d.docs.live.net") <> 0 Then
                    If InStr(2, strRemainderPath, "/") = 0 Then
                        strRemainderPath = vbNullString
                    Else
                        strRemainderPath = Mid(strRemainderPath, InStr(2, strRemainderPath, "/"))
                    End If
                End If
                
                'If OneDrive Business, adds extra slash at the start of string to match the pattern
                strRemainderPath = IIf(InStr(1, strUrlNamespace, "my.sharepoint.com") <> 0, "/", vbNullString) & strRemainderPath
                
                strLocalPath = ""
                
                If (InStr(1, strRemainderPath, "/")) <> 0 Then
                    strLocalPath = Mid(strRemainderPath, InStr(1, strRemainderPath, "/"))
                    strLocalPath = Replace(strLocalPath, "/", "\")
                End If
                
                strLocalPath = strMountPoint & strLocalPath
                GetWorkbookPath = strLocalPath
                If Dir(GetWorkbookPath & "\" & wb.Name) <> "" Then Exit Function
            End If
        Next
    End If
    
End Function

2022 年更轻松的 hack - 拆分路径并更改反斜杠的内容...

    FilePath = ws.Parent.Path & "\" & strN & ".txt"
    
    If LCase(FilePath) Like "http*sharepoint*" Then     ''Sharepoint hack to try to rewrite to local drive path...
        If FilePath Like "http*/Documents/*" Then ''we can take a guess to the local locaiton
            FilePath = Environ$("USERPROFILE") & "\[local OneDrive - pseudo-path]\Documents" & Right(FilePath, Len(FilePath) - 18 - InStr(1, FilePath, "documents/", vbTextCompare))
            FilePath = Replace(FilePath, "/", "\", 1, -1, vbTextCompare)
        Else
            MsgBox "Cannot save to OneDrive, malformed path. OK to cancel", vbCritical + vbOKOnly, "Malformed  path - Onedrive"
        End If
        Stop
        ''redirect to local ...
    End If