Problem getting ThisWorkbook.fullname when using shared OneDrive folder

Question

I am trying to get the full filename for an excel file which is one a shared OneDrive folder. I used the top answer from this question and it ALMOST worked but the incredibly wonky way we have our shared drive is giving me problems.

The way we have a shared drive is that one team member has our shared drive on their OneDrive and shares it with everyone else. (Yes we realize this is not the best method but we have yet to come up with a better one)

Anyway, when I use the method above, it takes my other team members folder name and duplicates it. In other words, when I run that function, I get

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

The problem is that the folder "Shared" is both at the end of strMountPoint and the beginning of strTemp, causing it to be repeated and therefore looking in a folder that does not exist.

An obvious solution is to just have it ignore everything before the first slash in strTemp but that seems like a quick and dirty way of doing it and I was hoping to find something a little more concrete

Answer 1

I had some old code, that I brushed up. It now works for my:

• personal OneDrive
• company OneDrive
• shared (company) SharePoint

It takes care of the localised shared compound folder name of SharePoint, thus it should work for you as well.

' 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