使用共享 OneDrive 文件夹时获取 ThisWorkbook.fullname 时出现问题

Question

我正在尝试获取一个 Excel 文件的完整文件名，该文件是一个共享的 OneDrive 文件夹。我使用了来自 this question 的最佳答案，它几乎可以正常工作，但是我们拥有共享驱动器的方式非常不稳定，这给我带来了问题。

我们拥有共享云端硬盘的方式是，一位团队成员在他们的 OneDrive 上拥有我们的共享云端硬盘，并与其他所有人共享。 （是的，我们意识到这不是最好的方法，但我们还没有想出更好的方法）

无论如何，当我使用上述方法时，它会使用我的其他团队成员文件夹名称并复制它。换句话说，当我运行那个函数时，我得到了

wb.fullname = https://mycompany.sharepoint.com/personal/JohnSmith/Documents/Shared/test.xlsx
strMountPoint = C:\Users\me\OneDrive\JohnSmith - Shared
strTemp = Shared/test.xlsx
GetLocalFile = C:\Users\me\OneDrive\JohnSmith - Shared\Shared\test.xlsx

问题是文件夹“Shared”既位于 strMountPoint 的末尾，又位于 strTemp 的开头，导致它被重复，因此在一个不存在的文件夹中查找。

一个明显的解决方案是让它忽略 strTemp 中第一个斜线之前的所有内容，但这似乎是一种快速而肮脏的方法，我希望找到更具体的东西

Answer 1

我有一些旧代码，我刷了一遍。它现在适用于我的：

• 个人 OneDrive
• 公司 OneDrive
• 共享（公司）SharePoint

它负责 SharePoint 的本地化共享复合文件夹名称，因此它也应该适用于您。

' Return the full local filename of a workbook stored in a shared folder on OneDrive or in SharePoint.
'
' 2021-12-29. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function LocalFullName( _
    ByVal Workbook As Excel.Workbook) _
    As String

    Const HKeyCurrentUser   As Long = &H80000001
    Const KeyPath           As String = "Software\SyncEngines\Providers\OneDrive\"
    Const TeamLibraryType   As String = "teamsite"
    Const SplitValue        As String = " - "
    
    Dim RegProv             As Object
    
    Dim SubKeys()           As Variant
    Dim Key                 As Variant
    Dim SubKeyName          As String
    Dim FullName            As String
    Dim SubPath             As String
    Dim LibraryTypeValue    As String
    Dim CidValue            As String
    Dim MountPointValue     As String
    Dim UrlNamespaceValue   As String
    Dim SplitPoint          As Integer
    Dim SharedFolderName    As String
    Dim ChopLength          As Integer
    
    Set RegProv = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    
    ' Get default full name.
    FullName = Workbook.FullName

    ' Read OneDrive settings.
    RegProv.EnumKey HKeyCurrentUser, KeyPath, SubKeys
    
    ' Loop the found keys to find the one holding this workbook.
    For Each Key In SubKeys
        SubKeyName = KeyPath & Key
        RegProv.GetStringValue HKeyCurrentUser, SubKeyName, "UrlNamespace", UrlNamespaceValue
    
        ' If FullName contains UrlNameSpace, this is the key holding the local mountpoint of the current file.
        If InStr(FullName, UrlNamespaceValue) > 0 Then
            
            ' Get the mount point for OneDrive
            RegProv.GetStringValue HKeyCurrentUser, SubKeyName, "MountPoint", MountPointValue
            
            ' Check if this a shared SharePoint path.
            RegProv.GetStringValue HKeyCurrentUser, SubKeyName, "LibraryType", LibraryTypeValue
            
            If LibraryTypeValue = TeamLibraryType Then
                ' Shared SharePoint company folder.
                SplitPoint = InStrRev(MountPointValue, SplitValue)
                If SplitPoint > 0 Then
                    ' Get second part of the shared subfolder name (Folder - Shared) of the mount point.
                    SharedFolderName = Mid(MountPointValue, SplitPoint + Len(SplitValue))
                Else
                    ' Should not happen.
                End If
                ' Cut the sub folder from the full name.
                SubPath = Mid(FullName, Len(UrlNamespaceValue & SharedFolderName) + 1)
            Else
                ' Get the CID
                RegProv.GetStringValue HKeyCurrentUser, SubKeyName, "CID", CidValue
            
                ' Find the length of the parent path of FullName.
                ChopLength = Len(UrlNamespaceValue & CidValue)
                ' Adjust for Commercial or Consumer path of OneDrive.
                If CidValue <> "" Then
                    ChopLength = ChopLength + 1
                ElseIf Right(UrlNamespaceValue, 1) = "/" Then
                    ChopLength = ChopLength - 1
                End If
    
                ' Cut off the parent path of FullName to have the namespace and the CID only.
                SubPath = Right(FullName, Len(FullName) - ChopLength)
            End If
            
            ' Replace forward slashes in SubPath with backslashes.
            FullName = MountPointValue & Replace(SubPath, "/", "\")
            
            Exit For
        End If
    Next
    
    Set RegProv = Nothing
    
    LocalFullName = FullName
    
End Function