Excel 的全名属性与 OneDrive

Question

如果我想在保存后使用打开的工作簿对象获取 Excel 文件的全名，但该文件已同步到 OneDrive，我会得到一个 "https" 地址而不是本地的，其他程序无法解释。
如何获取这样的文件的本地文件名？

示例：
将文件保存到 "C:\Users\user\OneDrive - Company\Documents".
OneDrive 进行同步。
查询 Workbook.FullName 现在显示为 "https://..."

Answer 1

我在网上找到了一个线程，其中包含足够的信息，可以将一些简单的东西放在一起来解决这个问题。我实际上在 Ruby 中实现了解决方案，但这是 VBA 版本：

Option Explicit

Private Function Local_Workbook_Name(ByRef wb As Workbook) As String

  Dim Ctr As Long
  Dim objShell As Object
  Dim UserProfilePath As String

  'Check if it looks like a OneDrive location
  If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then

    'Replace forward slashes with back slashes
    Local_Workbook_Name = Replace(wb.FullName, "/", "\")

    'Get environment path using vbscript
    Set objShell = CreateObject("WScript.Shell")
    UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")

      'Trim OneDrive designators
    For Ctr = 1 To 4
       Local_Workbook_Name = Mid(Local_Workbook_Name, InStr(Local_Workbook_Name, "\") + 1)
    Next

      'Construct the name
    Local_Workbook_Name = UserProfilePath & "\OneDrive\" & Local_Workbook_Name

  Else

    Local_Workbook_Name = wb.FullName

  End If

End Function

Private Sub testy()

  MsgBox ActiveWorkbook.FullName & vbCrLf & Local_Workbook_Name(ActiveWorkbook)

End Sub

Answer 2

很有帮助，谢谢。我遇到了类似的问题，但使用的是文件夹名称而不是文件名。因此我稍微修改了一下。我让它适用于文件夹名称和文件名（不一定是工作簿）。如果有帮助，代码如下：

Public Function Local_Name(theName As String) As String
    Dim i               As Integer
    Dim objShell        As Object
    Dim UserProfilePath As String

    ' Check if it looks like a OneDrive location.
    If InStr(1, theName, "https://", vbTextCompare) > 0 Then

        ' Replace forward slashes with back slashes.
        Local_Name = Replace(theName, "/", "\")

        'Get environment path using vbscript.
        Set objShell = CreateObject("WScript.Shell")
        UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")

        ' Trim OneDrive designators.
        For i = 1 To 4
            Local_Name = Mid(Local_Name, InStr(Local_Name, "\") + 1)
        Next i

        ' Construct the name.
        Local_Name = UserProfilePath & "\OneDrive\" & Local_Name
    Else
        ' (must already be local).
        Local_Name = theName
    End If
End Function

Answer 3

可以改进 Virtuoso 的答案以减少（但不能消除）函数 return 是 "wrong" 文件位置的可能性。问题是工作簿的 .FullName 可能有多种 URL。这是我知道的三个：

与用户的 OneDrive
与用户的 OneDrive for Business 关联的 URL
A URL 与其他人的 OneDrive 相关联，如果其他人拥有 "shared" 文件（在这种情况下，您通过文件 > 打开 > 与我共享来打开文件）

在我的 PC 上，我可以通过 OneDriveConsumer 和 OneDriveCommercial 环境变量获取相关的本地文件夹来映射前两个 URLs，除了 OneDrive 环境变量，所以下面的代码使用了这些。我不知道可以处理 "Shared with Me" 文件，下面的代码将 return 它们的 https:// 样式位置。

Private Function Local_Workbook_Name(ByRef wb As Workbook) As String

    Dim i As Long, j As Long
    Dim OneDrivePath As String
    Dim ShortName As String

    'Check if it looks like a OneDrive location
    If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
        'Replace forward slashes with back slashes
        ShortName = Replace(wb.FullName, "/", "\")

        'Remove the first four backslashes
        For i = 1 To 4
            ShortName = Mid(ShortName, InStr(ShortName, "\") + 1)
        Next

        'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
        For j = 1 To 3
            OneDrivePath = Environ(Choose(j, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
            If Len(OneDrivePath) > 0 Then
                Local_Workbook_Name = OneDrivePath & "\" & ShortName
                If Dir(Local_Workbook_Name) <> "" Then
                    Exit Function
                End If
            End If
        Next j
        'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
    End If

    Local_Workbook_Name = wb.FullName

End Function

遗憾的是，如果 OneDrive 文件夹和 OneDrive for Business 文件夹中存在具有相同路径的文件，则代码无法区分它们，并且可能 return "wrong one"。我没有解决方案。

Answer 4

我和你有同样的问题。但是我已经解决了那个问题。首先我在运行脚本之前关闭 OneDrive。

您可以将第一个脚本中的此脚本添加到您的 vba/module:

Call Shell("cmd.exe /S /C" & "%LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /shutdown")

然后，在 vba/module 上的最后一个脚本中，您可以插入此脚本以激活您的 OneDrive：

Call Shell("cmd.exe /S /C" & "start %LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /background")

我在该脚本上使用 Windows10。

Answer 5

轻松修复（2019 年初）- 对于遇到此问题的任何其他人：

OneDrive > 设置 > 办公室： - 取消选中 'Use Office applications to sync Office files that I open'

这允许 excel 以典型的 "C:\Users[UserName]\OneDrive..." 文件格式而不是 UNC "https:\" 格式保存文件。

Answer 6

这是 Philip Swannell 对 Virtuoso 的原始答案的改进的一个小改进，当要从路径中删除的“\”的数量超过 4 个/变化时（取决于文件，我发现我需要删除 5 个或有时其中 6 个）。 Philip提到的缺点还是存在的。

Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
'returns local wb path or nothing if local path not found
    Dim i As Long
    Dim OneDrivePath As String
    Dim ShortName As String
    Dim testWbkPath As String
    Dim OneDrivePathFound As Boolean

    'Check if it looks like a OneDrive location
    If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
        'Replace forward slashes with back slashes
        ShortName = Replace(wb.FullName, "/", "\")

        'Remove the first four backslashes
        For i = 1 To 4
            ShortName = RemoveTopFolderFromPath(ShortName)
        Next

        'loop through three OneDrive options
        For i = 1 To 3
            OneDrivePath = Environ(Choose(i, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
            If Len(OneDrivePath) > 0 Then
                'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
                Do While ShortName Like "*\*"
                    testWbkPath = OneDrivePath & "\" & ShortName
                    If Not (Dir(testWbkPath)) = vbNullString Then
                        OneDrivePathFound = True
                        Exit Do
                    End If
                    'remove top folder in path
                    ShortName = RemoveTopFolderFromPath(ShortName)
                Loop
            End If
            If OneDrivePathFound Then Exit For
        Next i
    Else
        Local_Workbook_Name = wb.FullName
    End If

    If OneDrivePathFound Then Local_Workbook_Name = testWbkPath

End Function
Function RemoveTopFolderFromPath(ByVal ShortName As String) As String
    RemoveTopFolderFromPath = Mid(ShortName, InStr(ShortName, "\") + 1)
End Function

Answer 7

我猜 JK2017 的代码中有一个小错误："ShortName"-变量必须在这 3 个版本的 OneDrive 的每次启动时重建。所以 ist 必须在 'For i = 1 To 3' 循环内。我还添加了仅获取路径而不是完整文件名的选项。

Private Function Local_Workbook_Name(ByRef wb As Workbook, Optional bPathOnly As Boolean = False) As String
'returns local wb path or nothing if local path not found
Dim i As Long, x As Long
Dim OneDrivePath As String
Dim ShortName As String
Dim testWbkPath As String
Dim OneDrivePathFound As Boolean

'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then

    'loop through three OneDrive options
    For i = 1 To 3
        'Replace forward slashes with back slashes
        ShortName = Replace(wb.FullName, "/", "\")

        'Remove the first four backslashes
        For x = 1 To 4
            ShortName = RemoveTopFolderFromPath(ShortName)
        Next
        'Choose the version of Onedrive
        OneDrivePath = Environ(Choose(i, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
        If Len(OneDrivePath) > 0 Then
            'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
            Do While ShortName Like "*\*"
                testWbkPath = OneDrivePath & "\" & ShortName
                If Not (Dir(testWbkPath)) = vbNullString Then
                    OneDrivePathFound = True
                    Exit Do
                End If
                'remove top folder in path
                ShortName = RemoveTopFolderFromPath(ShortName)
            Loop
        End If
        If OneDrivePathFound Then Exit For
    Next i
Else
    If bPathOnly Then
        Local_Workbook_Name = RemoveFileNameFromPath(wb.FullName)
    Else
        Local_Workbook_Name = wb.FullName
    End If
End If
If OneDrivePathFound Then
        If bPathOnly Then
        Local_Workbook_Name = RemoveFileNameFromPath(testWbkPath)
    Else
        Local_Workbook_Name = testWbkPath
    End If
End If
End Function

Function RemoveTopFolderFromPath(ByVal ShortName As String) As String
   RemoveTopFolderFromPath = Mid(ShortName, InStr(ShortName, "\") + 1)
End Function

Function RemoveFileNameFromPath(ByVal ShortName As String) As String
   RemoveFileNameFromPath = Mid(ShortName, 1, Len(ShortName) - InStr(StrReverse(ShortName), "\"))
End Function

Answer 8

不同数量的斜线“/”可能与不同版本的 OneDrive (private/professional)有关。对比msdn网站上的MatChrupczalski post： https://social.msdn.microsoft.com/Forums/en-US/1331519b-1dd1-4aa0-8f4f-0453e1647f57/how-to-get-physical-path-instead-of-url-onedrive?forum=officegeneral

因此我将函数调整为以下内容：

Sub TestMySolution()
  MsgBox ActiveWorkbook.FullName & vbCrLf & LocalFullName(ActiveWorkbook.FullName)
End Sub

' 29.03.2020 Horoman
' main parts by Philip Swannell 14.01.2019    
' combined with parts from MatChrupczalski 19.05.2019
' using environment variables of OneDrive
Private Function LocalFullName(ByVal fullPath As String) As String
  Dim i As Long, j As Long
  Dim oneDrivePath As String
  Dim endFilePath As String
  Dim iDocumentsPosition As Integer

  'Check if it looks like a OneDrive location
  If InStr(1, fullPath, "https://", vbTextCompare) > 0 Then

    'for commercial OneDrive file path seems to be like "https://companyName-my.sharepoint.com/personal/userName_domain_com/Documents" & file.FullName)
    If InStr(1, fullPath, "my.sharepoint.com") <> 0 Then
      'find "/Documents" in string and replace everything before the end with OneDrive local path
      iDocumentsPosition = InStr(1, fullPath, "/Documents") + Len("/Documents") 'find "/Documents" position in file URL
      endFilePath = Mid(fullPath, iDocumentsPosition)  'get the ending file path without pointer in OneDrive
    Else
      'for personal onedrive it looks like "https://d.docs.live.net/d7bbaa#######1/" & file.FullName, _
      '   by replacing "https.." with OneDrive local path obtained from registry we can get local file path
      'Remove the first four backslashes
      endFilePath = Mid(fullPath, 9) ' removes "https://" and with it two backslashes
      For i = 1 To 2
        endFilePath = Mid(endFilePath, InStr(endFilePath, "/") + 1)
      Next
    End If

    'Replace forward slashes with back slashes (URL type to Windows type)
    endFilePath = Replace(endFilePath, "/", Application.PathSeparator)

    'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
    For j = 1 To 3
      oneDrivePath = Environ(Choose(j, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
      If Len(oneDrivePath) > 0 Then
          LocalFullName = oneDrivePath & Application.PathSeparator & endFilePath
          If Dir(LocalFullName) <> "" Then
            Exit Function 'that is it - WE GOT IT
          End If
      End If
    Next j
    'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
    LocalFullName = ""
  End If

  LocalFullName = fullPath
End Function

玩得开心。

Answer 9

(2020-03-30) 很好，因为它适用于私人和商业 OneDrive。但是它在我身上崩溃了，因为行“LocalFullName = oneDrivePath & Application.PathSeparator & endFilePath”在 oneDrivePath 和 endFilePath 之间插入了一个斜杠。此外，在“OneDrive”之前，应该真正尝试路径“OneDriveCommercial”和“OneDriveConsumer”。所以这是对我有用的代码：

Sub TestLocalFullName()
    Debug.Print "URL: " & ActiveWorkbook.FullName
    Debug.Print "Local: " & LocalFullName(ActiveWorkbook.FullName)
    Debug.Print "Test: " & Dir(LocalFullName(ActiveWorkbook.FullName))
End Sub

Private Function LocalFullName$(ByVal fullPath$)
    'Finds local path for a OneDrive file URL, using environment variables of OneDrive
    'Reference 
    '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 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)
        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
                LocalFullName = 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
        LocalFullName = vbNullString
    Else
        LocalFullName = fullPath
    End If
End Function

Answer 10

这真是太棒了。我运行在一些 windows 10 台机器上遇到过这个问题，但在其他机器上没有，而且它似乎来来去去。我尝试了所有重置 OneDrive、更改配置等的方法。我尝试过的唯一至少在我的机器上有效的方法是使用 Fullname=CurDir & FileName，而不是 FullName= activeworkbook.Path & FileName.

这返回了没有 https 内容的完整本地名称，我能够正常打开我的文件。

Answer 11

而不是使用变量 ThisWorkbook.Path 使用 Environ("OneDrive").

Option Explicit
'
Function TransferURL(wbkURL As String) As String
' Converts the URL of a OneDrive into a path.
' Returns the path's name.
    
    Dim oFs As Object
    Dim oFl As Object
    Dim oSubFl As Object
 
    Dim pos As Integer
    Dim pathPart As String
    Dim oneDrive As String
    Dim subFl As String
        
    Set oFs = CreateObject("Scripting.FileSystemObject")
        
    ' Check the version of OneDrive.
    If VBA.InStr(1, _
                 VBA.UCase(wbkURL), "MY.SHAREPOINT.COM") = 0 Then
        
        oneDrive = "OneDriveConsumer"
        
    Else
        
        oneDrive = "OneDriveCommercial"
        
    End If
    
    Set oFl = oFs.GetFolder(Environ(oneDrive))
    
    ' Iteration over OneDrive's subfolders.
    For Each oSubFl In oFl.SUBFOLDERS
        
        subFl = "/" & VBA.Mid(oSubFl.Path, _
                              VBA.Len(Environ(oneDrive)) + 2) & "/"
    
        ' Check if part of the URL.
        If VBA.InStr(1, _
                     wbkURL, subFl) > 0 Then
                
            ' Determine the path after OneDrive's folder.
            pos = VBA.InStr(1, _
                            wbkURL, subFl)
        
            pathPart = VBA.Mid(VBA.Replace(wbkURL, "/", _
                                           Application.PathSeparator), pos)
        
        End If
    
    Next
    
    TransferURL = Environ(oneDrive) & pathPart

End Function

通过以下方式调用函数：

' Check if path specification as URL.
If VBA.Left(VBA.UCase(oWbk.Path), _
            5) = "HTTPS" Then

    ' Call ...
    pathName = TransferURL(oWbk.Path)

End If

OneDriveConsumer 和 OneDriveCommercial 的区别来自：

https://social.msdn.microsoft.com/Forums/en-US/1331519b-1dd1-4aa0-8f4f-0453e1647f57/how-to-get-physical-path-instead-of-url-onedrive?forum=officegeneral

由 MatChrupczalski 编辑，2019 年 5 月 9 日星期四 5:45 下午

Answer 12

Option Explicit

Private coll_Locations As Collection            ' using Collection but could just as easily use Dictionary
Public Const HKEY_CURRENT_USER = &H80000001
'

Public Function getOneDrv_PathFor(ByVal sPath As String, Optional ByVal sType As String = "") As String
' convert start of passed in path from URL to Local or vice.versa, (for OneDrive Sync'd folders)
' sType : if starts L(ocal) return local path, if starts U(rl) then return URL Path, else return other mode to that passed in
    Dim sPathNature As String
    Dim vKey As Variant
    Dim Slash As String, Slash2 As String
    
    getOneDrv_PathFor = sPath ' return unchanged if no action required or recognised
    
    sType = UCase(Left(sType, 1))
    If sType <> "L" And sType <> "U" Then sType = ""
    sPathNature = IIf(Left(sPath, 4) = "http", "U", "L")
    If sType <> "" And sType = sPathNature Then Exit Function  ' nothing to do
    
    If coll_Locations Is Nothing Then get_Locations
    
    For Each vKey In coll_Locations
        If InStr(1, sPath, vKey, vbTextCompare) = 1 Then
            Slash = IIf(sPathNature = "U", "/", "\")
            Slash2 = IIf(Slash = "/", "\", "/")
            getOneDrv_PathFor = coll_Locations(vKey) & Replace(Mid(sPath, Len(vKey) + 1), Slash, Slash2)
            Exit For
        End If
    Next
    
End Function


Private Sub get_Locations()
' collect possible OneDrive: URL vs Local paths

    Dim oWMI As Object
    Dim sRegPath As String, arrSubKeys() As Variant, vSubKey As Variant
    Dim sServiceEndPointUri As String, sUserFolder As String

    Set coll_Locations = New Collection

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\.\root\default:StdRegProv")
    sRegPath = "Software\Microsoft\OneDrive\Accounts\"
    oWMI.EnumKey HKEY_CURRENT_USER, sRegPath, arrSubKeys
    
    For Each vSubKey In arrSubKeys
        oWMI.GetStringValue HKEY_CURRENT_USER, sRegPath & vSubKey, "ServiceEndPointUri", sServiceEndPointUri
        oWMI.GetStringValue HKEY_CURRENT_USER, sRegPath & vSubKey, "UserFolder", sUserFolder
        If sServiceEndPointUri <> "" And sUserFolder <> "" Then
            If Right(sServiceEndPointUri, 5) = "/_api" Then sServiceEndPointUri = Left(sServiceEndPointUri, Len(sServiceEndPointUri) - 4) & "Documents/"
            sUserFolder = sUserFolder & "\"
            coll_Locations.Add Item:=sServiceEndPointUri, Key:=sUserFolder
            coll_Locations.Add Item:=sUserFolder, Key:=sServiceEndPointUri
        End If
    Next
    'listOneDrv_Locations
  
    Set oWMI = Nothing
End Sub

Public Sub listOneDrv_Locations()
    ' to list what's in the collection
     Dim vKey As Variant
    ' Set coll_Locations = Nothing
    If coll_Locations Is Nothing Then get_Locations
    For Each vKey In coll_Locations
        Debug.Print vKey, coll_Locations(vKey)
    Next
End Sub

然后获取 LocalPath 将是 strLocalPath = getOneDrv_PathFor(strCurrentPath, "本地")

Answer 13

我已经调整了其他人提供的功能以解决一些额外的限制：

当您通过团队站点共享文件时，您应该使用“my.sharepoint.com/”而不是“sharepoint.com/”来确定它是否是商业版本。
最好计算斜杠而不是使用“/Documents”的位置，因为例如在法语中，文档文件夹称为“Documents partages”。商业用最好算4个斜线，个人用2个斜线。
如果作为快捷方式添加到 OneDrive 的 SharePoint 文件夹不在根目录下，则硬盘上的本地地址不包含 SharePoint 上的父文件夹。

这是考虑了我的更改的代码：

Public Function AdresseLocal$(ByVal fullPath$)
    'Finds local path for a OneDrive file URL, using environment variables of OneDrive
    'Reference 
    '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$
    Dim NbSlash
    
    If Left(fullPath, 8) = "https://" Then
        If InStr(1, fullPath, "sharepoint.com/") <> 0 Then 'Commercial OneDrive
            NbSlash = 4
        Else 'Personal OneDrive
            NbSlash = 2
        End If
        iPos = 8 'Last slash in https://
        For ii = 1 To NbSlash
            iPos = InStr(iPos + 1, fullPath, "/")
        Next ii
        endFilePath = Mid(fullPath, iPos)
        endFilePath = Replace(endFilePath, "/", Application.PathSeparator)
        For ii = 1 To 3
            oneDrivePath = Environ(Choose(ii, "OneDriveCommercial", "OneDriveConsumer", "OneDrive"))
            If 0 < Len(oneDrivePath) Then Exit For
        Next ii
        AdresseLocal = oneDrivePath & endFilePath
        While Len(Dir(AdresseLocal, vbDirectory)) = 0 And InStr(2, endFilePath, Application.PathSeparator) > 0
            endFilePath = Mid(endFilePath, InStr(2, endFilePath, Application.PathSeparator))
            AdresseLocal = oneDrivePath & endFilePath
        Wend
    Else
        AdresseLocal = fullPath
    End If
End Function

...它建立在不同贡献者的工作之上。

Answer 14

称我为黑客，但我机器上的 http 引用总是相同的，所以我查看了硬盘驱动器上可以找到 OneDrive 的本地引用

假设 C:\MyOneDrive\OneDrive 然后将不需要的工作簿路径的所有其他部分添加到本地部分。然后切换斜线方向

folder = "C:\MyOneDrive\OneDrive" & Right(Application.ActiveWorkbook.Path, Len(Application.ActiveWorkbook.Path) - 72) & "\"
folder = Replace(folder, "/", "\")

我的两条线涵盖了我机器上的所有案例！！

Answer 15

我知道这个问题被标记为 VBA，但我在尝试使用 C# 解决问题时发现了这个问题。我写了一个类似于@TWMIC 答案的版本如下：

string LocalPath( string fullPath )
{
    if ( fullPath.StartsWith( "https://", StringComparison.InvariantCultureIgnoreCase ) )
    {
        // So Documents/ location works below
        fullPath = fullPath.Replace( "\", "/" );
        
        var userAccounts = Microsoft.Win32.Registry.CurrentUser
            .OpenSubKey(@"Software\Microsoft\OneDrive\Accounts\");

        if (userAccounts != null)
        {
            foreach (var accountName in userAccounts.GetSubKeyNames())
            {
                var account = userAccounts.OpenSubKey(accountName);
                var endPoint = account.GetValue("ServiceEndPointUri") as string;
                var userFolder = account.GetValue("UserFolder") as string;

                if (!string.IsNullOrEmpty(endPoint) && !string.IsNullOrEmpty(userFolder))
                {
                    if (endPoint.EndsWith("/_api"))
                    {
                        endPoint = endPoint.Substring(0, endPoint.Length - 4) + "documents/";
                    }

                    if (fullPath.StartsWith(endPoint, StringComparison.InvariantCultureIgnoreCase))
                    {
                        return Path.Combine(userFolder, fullPath.Substring(endPoint.Length));
                    }
                }
            }
        }
    }

    return fullPath;
}

Answer 16

你好，我就是这样做的，我找到了通过“SOFTWARE\SyncEngines\Providers\OneDrive”的路径：

private static string GetLocalPath(string url)
    {
        try
        {
            var oneDriveKey = Registry.CurrentUser.OpenSubKey(@"Software\SyncEngines\Providers\OneDrive");

            if (oneDriveKey != null)
            {
                foreach (var subKeyName in oneDriveKey.GetSubKeyNames())
                {
                    var subKey = oneDriveKey.OpenSubKey(subKeyName);

                    if (subKey != null)
                    {
                        var urlNameSpace = subKey.GetValue("UrlNamespace").ToString().Trim('/');

                        if (url.Contains(urlNameSpace) && subKey.GetValue("MountPoint") is string localLibraryPath)
                        {
                            string restOfDocumentPath = url.Substring(urlNameSpace.Length);
                            restOfDocumentPath = restOfDocumentPath.Replace('/', '\');

                            return localLibraryPath + restOfDocumentPath;
                        }
                    }
                }
            }
        }
        catch (Exception e)
        {
            Console.WriteLine(e.Message);
        }

        return string.Empty;
    }

Answer 17

我喜欢使用注册表的 TWMIC 版本。所有其他版本都不适用于我的 oneDrive for Business。有些文件夹的名称与 URL 略有不同，例如 URL 中部分没有空格，但文件夹中有。如果它来自 Teams，并且在 Team Name 中有空格，那么这是一个问题。甚至来自 Teams 的文件夹名称也不同于 URL，具体取决于您同步的 Teams 中的文件夹级别。

TWMIC 的版本在我的工作计算机上被标记为危险，我无法使用它，对此感到非常难过。所以我制作了一个从 oneDrive for Business 读取 ini 文件的版本，如果它是 OneDrive for Business...

Public Function AdresseLocal$(ByVal fullPath$)
'Finds local path for a OneDrive file URL, using environment variables of OneDrive and loading the settings ini File of OneDrive
'Reference 
'Authors: Philip Swannell 2019-01-14, MatChrupczalski 2019-05-19, Horoman 2020-03-29, P.G.Schild 2020-04-02, Iksi 2021-08-28
Dim ScreenUpdate As Boolean
Dim ii&
Dim iPos&
Dim DatFile$, SettingsDir$, Temp$
Dim oneDrivePath$, oneDriveURL$
Dim endFilePath$

If Left(fullPath, 8) = "https://" Then
    If InStr(1, fullPath, "sharepoint.com") <> 0 Then 'Commercial OneDrive
        'Find the correct settings File, I'm not sure if it is always in Folder Business1, so trying to find a Folder Business and then Business1, 2 ....
        'First find *.dat File, seems to be only one of that type, the correct ini File is the same Name than the dat File
        DatFile = Dir(Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business\*.dat")
        If DatFile <> "" Then SettingsDir = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business\"
        For ii = 1 To 9
            Temp = Dir(Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business" & ii & "\*.dat")
            If Temp <> "" Then
                If SettingsDir = "" Then
                    DatFile = Temp
                    SettingsDir = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business" & ii & "\"
                Else
                    MsgBox "There is more than one OneDrive settings Folder!"
                End If
            End If
        Next
        'Open ini File without showing
        ScreenUpdate = Application.ScreenUpdating
        Application.ScreenUpdating = False

        Workbooks.OpenText Filename:= _
            SettingsDir & Left(DatFile, Len(DatFile) - 3) & "ini" _
            , Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
            :=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:= _
            False, Comma:=False, Space:=True, Other:=False, TrailingMinusNumbers:=True
        ii = 1
        Do While Cells(ii, 1) = "libraryScope"
        'Search the correct URL which fits to the fullPath and then search the corresponding Folder
            If InStr(fullPath, Cells(ii, 9)) = 1 Then
                oneDriveURL = Cells(ii, 9)
                If Cells(ii, 15) <> "" Then
                    oneDrivePath = Cells(ii, 15)
                Else
                    iPos = Cells(ii, 3)
                    Do Until Cells(ii, 1) = "libraryFolder"
                        ii = ii + 1
                    Loop
                    Do While Cells(ii, 1) = "libraryFolder"
                        If Cells(ii, 4) = iPos Then
                            oneDrivePath = Cells(ii, 7)
                            Exit Do
                        End If
                        ii = ii + 1
                    Loop
                End If
                Exit Do
            End If
            ii = ii + 1
        Loop
        ActiveWorkbook.Close False
        Application.ScreenUpdating = ScreenUpdate
        
        endFilePath = Mid(fullPath, Len(oneDriveURL) + 1)
        
    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)
    If Len(oneDrivePath) <= 0 Then
        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
        Next ii
    End If
    
    AdresseLocal = oneDrivePath & endFilePath
    While Len(Dir(AdresseLocal, vbDirectory)) = 0 And InStr(2, endFilePath, Application.PathSeparator) > 0
        endFilePath = Mid(endFilePath, InStr(2, endFilePath, Application.PathSeparator))
        AdresseLocal = oneDrivePath & endFilePath
    Wend
Else
    AdresseLocal = fullPath
End If
End Function

对我来说这很好用！

Excel 的全名 属性 与 OneDrive

Excel's fullname property with OneDrive

excel

vba

onedrive

Excel 的全名属性与 OneDrive