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

Question

更新2021-03-20：我发现，即使我将文件(我想引用的文件(从OneDrive复制到不属于OneDrive的本地文件夹并引用它，也会发生同样的事情。只有在我重命名了文件之后，我才能引用它，而不会将其路径变成URL(假设指向我的在线OneDrive(。这不符合我的需要。我正试图找到一种方法，在不同设备上不同位置的不同应用程序之间共享我的VBA代码库。如果我搞不清楚的话，我可能会提出一个单独的问题。

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

例如，

1. 打开xlsm项目

2. 打开VBA IDE

3. 选择"工具"->VBIDE菜单中的参考

4. 浏览以添加对另一个xlsm文件的引用
   a。例如，C:\Users\Andbio\OneDrive \代码库\RYTEwayCode(XLSM(.XLSM

   b。确保在"；添加引用"；打开的"文件打开"对话框。

   c。选择要引用的xlsm文件，然后单击"；打开"；。

   d。在"；位置："；字段位于"；参考文献"；对话框中，它显示本地路径。

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

此时，一切正常，您可以在刚才引用的文件中执行代码。因此，参考文献是有效的。

6. 选择工具->再次从VBIDE菜单中引用
7. 选择您刚刚添加的引用
8. 请注意，现在，在"；位置："；字段，其中引用文件的本地路径已被替换为URL。就我而言，它现在说："；https://d.docs.live.net/8e13263ac9cf0594/CodeLibraries/RYTEwayCode(XLSM(.XLSM">

如果我现在保存并关闭XLSM文件，并尝试重新打开它，我会收到一个错误，说它在上面步骤8中显示的URL路径上找不到文件。我不得不以安全模式(/s(重新打开它，以便再次打开文件以删除引用。

我知道为什么会发生这种情况，为什么它是这样设计的，我只需要一种方法来绕过它，如果有的话。是否仍然可以将我引用的文件存储在OneDrive上，而不将我的XLSM文件存储在同一OneDrive上？

Answer 1

当您添加对XLSM文件的引用时，VBA基本上会像使用"打开文件"命令一样打开工作簿。因此，当第一个工作簿的"打开"事件被触发时，您可以打开第二个工作簿。如果工作簿保存在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}!\.rootdefault:StdRegProv")

strRegistryPath = "SOFTWARESyncEnginesProvidersOneDrive"
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

Answer 2

2022年的一个更轻松的破解方法-拆分路径并将"破解"(/(更改为反斜杠。。。

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