Handling the Obfuscation of ThisWorkbook.Path and .FullName for OneDrive and Sharepoint Files

VBA

A workaround to convert the obfuscated OneDrive and Sharepoint URLs returned by these two properties into valid local file paths.

As we have continued to experience OneDrive, the frustrations with it continue. This article is about a specific challenge in the Excel VBE: the two properties ThisWorkbook.Path and ThisWorkbook.FullName.

For some reason we absolutely cannot fathom, Excel returns a useless URL when reading these two properties in a workbook opened from any OneDrive or SharePoint shared location. For example, consider this ThisWorkbook.FullName value when the workbook is opened from any location other than a OneDrive shared folder:

C:\Users\User Name\Just Another Workbook.xlsx

Put that workbook in any OneDrive shared folder, and this is returned:

https://datapros-my.sharepoint.com/personal/kjones_dataautopros_com/Documents/Just Another Workbook.xlsx

where the actual local path is:

C:\Users\User Name\OneDrive - Data Automation Professionals\Just Another Workbook.xlsx

Right off the bat it's painfully obvious that the URL is useless to anyone and everyone. One of the most common automation tasks that use ThisWorkbook.FullName or ThisWorkbook.Path is to navigate around using the folder in which the workbook is located as a starting point. There is no easy way to translate that URL into a local path. It is possible but it's a tricky operation — more on that later. What else is that URL good for? We have no idea.

The whole idea of sharing folders and files on a local drive is so they can be used the same way as if they were in a non-shared folder, and so we don't have to go to the online location and either download the file or open it in a browser. Dropbox did it right. Google Drive did it right. What were the Microsoft engineers thinking by exposing the URL to us versus the local path?

A lot of people have said to turn off some OneDrive option. Even if that did work, it is no longer available in the current OneDrive UI/UX.

People have written URL parsers and file search routines to try to translate the URL into a local path. A StackOverflow thread got crazy with ideas but none of the solutions worked in all scenarios. Remember that OneDrive supports one personal account, up to nine business accounts, and SharePoint folders. Each of these have different structures in their URLs without any obvious mapping to the folder on the local drive. We did find one possible solution in that thread using information stored in the Registry that showed promise. Starting with that, we reworked it so that it worked in as many scenarios as we could find.

The Fix

Below is the routine for getting the local path as it should be returned in FullName. It has been tested on multiple machines, Windows 10 and 11, and SharePoint and OneDrive shared folders. Let us know if you make any improvements or fix any issues.

Public Function OneDriveLocalFilePath( _
        Optional ByRef OneDriveFilePath As String, _
        Optional ByVal ReturnFolderPathOnly As Boolean, _
        Optional ByVal ReturnEmptyIfFileNotFound As Boolean _
    ) As String
' Returns the local file path given a URL to a file stored in a OneDrive or SharePoint
' folder. For some reason the Excel Workbook properties Path and FullName return URLs
' instead of local paths.
'
' OneDriveFilePath - Any valid local path or URL referencing a OneDrive file. If the path
'   cannot be resolved, the original path is returned. Optional. If omitted then
'   ThisWorkbook.FullName is assumed.
'
' ReturnFolderPathOnly - Pass True to return the folder path only. This is the equivalent
'   of ThisWorkbook.Path. Optional. If omitted then False is assumed.
'
' ReturnEmptyIfFileNotFound - Pass True to return an empty or null string if the file
'   cannot be found, False to return an error message. Optional. If omitted then False
'   is assumed.
'
' Notes
'
' Debugging information is written to a text file in the Desktop folder when the conditional
' compilation argument Debugging is set to -1. This argument can be set in this module or
' in the project properties dialog.

    Const RegistryPath As String = "HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive\"

    Dim WScript As Object
    Dim WinMgmtS As Object
    Dim Result As String
    Dim ProposedFilePath As String
    Dim ConfirmedFilePath As String
    Dim RegistryKey As Variant
    Dim RegistryKeys As Variant
    Dim Types As Variant
    Dim CID As String
    Dim MountPoint As String
    Dim WebURL As String
    Dim URLNamespace As String
    Dim FullRemotePath As String
    Dim URLInstance As Long
    Dim url As String
    Dim URLCount As Long
    Dim LibraryType As String
    Dim URLExtended As String
    Dim LocalPartialPath As String
    Dim PartialPathRootDirectory As String
    Dim Pass As Long
    Dim EntryCount As Long
    Dim ExistsCount As Long
    Dim Log As String
    Dim LogFilePath As String
    Dim FileNumber As Long
    Dim FileLength As Long

    OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Entering OneDriveLocalFilePath"

    ' Default to the full name property of ThisWorkbook
    If Len(OneDriveFilePath) = 0 Then
        OneDriveFilePath = ThisWorkbook.FullName
    End If

    OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "OneDrive file path: " & OneDriveFilePath

    ' Determine if the path is a URL or a local path
    If Left(OneDriveFilePath, 8) = "https://" Then

        ' WScript and Winmgmts are used to navigate the registry
        Set WScript = CreateObject("WScript.Shell")
        Set WinMgmtS = GetObject("Winmgmts:root\default:StdRegProv")

        For Pass = 1 To 2

            ExistsCount = 0

            OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Evaluating registry entries in '" & RegistryPath & "'"

            ' Enumerate the key HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive
            If WinMgmtS.EnumKey(&H80000001, Mid(RegistryPath, InStr(RegistryPath, "\") + 1), RegistryKeys, Types) = 0 Then

                EntryCount = 0

                For Each RegistryKey In RegistryKeys

                    OneDriveLocalFilePath_WriteDebuggingLog Log

                    ' Each key has five values of interest:
                    '
                    '   CID           - Some hash code sometimes used in the path
                    '   WebURL        - The URL to a parent directory in the cloud
                    '   URLNameSpace  - The main "name space" URL
                    '   FullRemotePath - A subordinate directory of the name space URL
                    '   MountPoint    - The local path OneDrive uses to mirror files

                    CID = vbNullString
                    MountPoint = vbNullString
                    WebURL = vbNullString
                    URLNamespace = vbNullString
                    FullRemotePath = vbNullString
                    ProposedFilePath = vbNullString

                    On Error Resume Next
                    CID = WScript.RegRead(RegistryPath & RegistryKey & "\CID")
                    MountPoint = WScript.RegRead(RegistryPath & RegistryKey & "\MountPoint")
                    WebURL = WScript.RegRead(RegistryPath & RegistryKey & "\WebURL")
                    URLNamespace = WScript.RegRead(RegistryPath & RegistryKey & "\URLNamespace")
                    FullRemotePath = WScript.RegRead(RegistryPath & RegistryKey & "\FullRemotePath")
                    LibraryType = WScript.RegRead(RegistryPath & RegistryKey & "\LibraryType")
                    On Error GoTo 0

                    EntryCount = EntryCount + 1
                    OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Evaluating registry entry " & EntryCount
                    OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "Key:", (RegistryKey)
                    OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "CID:", CID
                    OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "WebURL:", WebURL
                    OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "URLNamespace:", URLNamespace
                    OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "FullRemotePath:", FullRemotePath
                    OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "MountPoint:", MountPoint
                    OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "LibraryType:", LibraryType

                    If Len(MountPoint) > 0 Then

                        URLCount = 0

                        For URLInstance = 1 To 3

                            Select Case URLInstance
                                Case 1
                                    url = URLNamespace
                                Case 2
                                    url = WebURL
                                Case 3
                                    url = FullRemotePath
                            End Select

                            If Len(url) > 0 Then

                                URLCount = URLCount + 1

                                OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "Evaluating URL:", url

                                ' Remove any trailing slash from URL
                                If Right(url, 1) = "/" Then
                                    url = Left(url, Len(url) - 1)
                                End If

                                ' Determine extended URL name space which may or may not include CID
                                If Len(CID) = 0 Then
                                    URLExtended = url
                                Else
                                    URLExtended = url & "/" & CID
                                    If Left(OneDriveFilePath, Len(URLExtended)) <> URLExtended Then
                                        URLExtended = url
                                    End If
                                End If

                                ' Looking for a local file path only if the base of the path being
                                ' evaluated matches the extended URL
                                If Left(OneDriveFilePath, Len(URLExtended)) = URLExtended Then

                                    LocalPartialPath = Mid(OneDriveFilePath, Len(URLExtended) + 2)
                                    LocalPartialPath = Replace(Replace(LocalPartialPath, "/", "\"), "%20", Space(1))

                                    Do While Len(LocalPartialPath) > 0

                                        ' It's not clear how much of the local partial path is used
                                        ' for the local path so all possible paths are tried by
                                        ' removing the highest level folder each pass until none left
                                        If InStr(LocalPartialPath, "\") > 0 Then
                                            PartialPathRootDirectory = Left(LocalPartialPath, InStr(LocalPartialPath, "\") - 1)
                                        Else
                                            PartialPathRootDirectory = vbNullString
                                        End If

                                        If Pass = 1 Or Pass = 2 And LibraryType = "teamsite" And Right(MountPoint, Len(PartialPathRootDirectory)) = PartialPathRootDirectory Then
                                            OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "Local partial path:", LocalPartialPath
                                            If OneDriveLocalFilePath_FileExists(MountPoint & "\" & LocalPartialPath, ConfirmedFilePath, ExistsCount, Log) Then Exit For
                                        Else
                                            If Pass = 2 Then
                                                OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "Not a team site or right part of directory of mount point does not match the first directory of the partial path."
                                            End If
                                        End If

                                        ' Remove the root directory and try again
                                        If Len(PartialPathRootDirectory) > 0 Then
                                            LocalPartialPath = Mid(LocalPartialPath, InStr(LocalPartialPath, "\") + 1)
                                        Else
                                            LocalPartialPath = vbNullString
                                        End If

                                    Loop

                                Else

                                    OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "URL name does not match base of OneDrive file path."

                                End If

                            End If

                        Next URLInstance

                    Else

                        OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "No mount point found."

                    End If

                    If URLCount = 0 Then
                        OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "No URLs were found."
                    End If

                Next RegistryKey

                ' Return the confirmed file path if a valid path was found
                If Len(ConfirmedFilePath) > 0 Then
                    If ReturnFolderPathOnly And InStr(ConfirmedFilePath, "\") > 0 Then
                        Result = Left(ConfirmedFilePath, InStrRev(ConfirmedFilePath, "\") - 1)
                    Else
                        Result = ConfirmedFilePath
                    End If
                Else
                    OneDriveLocalFilePath_WriteDebuggingLog Log
                    OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "No local path was found."
                End If

            Else

                OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "No registry entries were found."

                Result = OneDriveFilePath

            End If

            If ExistsCount < 2 Then Exit For

            If Pass = 1 Then
                OneDriveLocalFilePath_WriteDebuggingLog Log
                OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "More than one existing file was found in the first pass."
                OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Doing another pass and adding an extra check for a team site with matching share drive base folder."
            End If

        Next Pass

    Else
        ' The path is not a URL so return it as-is
        If ExistingFile(OneDriveFilePath) Then
            OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Provided path name is not a URL and was found."
            ExistsCount = 1
            If ReturnFolderPathOnly And InStr(OneDriveFilePath, "\") > 0 Then
                Result = Left(OneDriveFilePath, InStrRev(OneDriveFilePath, "\") - 1)
            Else
                Result = OneDriveFilePath
            End If

        ElseIf ExistingFolder(OneDriveFilePath) Then
            OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Provided folder path is not a URL and was found."
            ExistsCount = 1
            Result = OneDriveFilePath
        Else
            OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Provided path name is not a URL and was not found."
        End If
    End If

    If ExistsCount = 0 Then
        If Not ReturnEmptyIfFileNotFound Then
            Result = "A local file path to an existing file was not found."
        End If
    End If

    OneDriveLocalFilePath_WriteDebuggingLog Log
    OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "OneDrive result: " & Result

    #If Debugging Then
        LogFilePath = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\" & "OneDrive Local File Path.txt"
        On Error Resume Next
        Kill LogFilePath
        On Error GoTo 0
        FileNumber = FreeFile
        Open LogFilePath For Binary Access Read Write Lock Read Write As FileNumber
        Put FileNumber, , Log
        Close FileNumber
    #End If

    OneDriveLocalFilePath = Result

End Function

Private Function OneDriveLocalFilePath_FileExists( _
        ByRef ProposedFilePath As String, _
        ByRef ConfirmedFilePath As String, _
        ByRef ExistsCount As Long, _
        ByRef Log As String _
    ) As Boolean
' Tests if file path exists. Internal use only.

    OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "Checking proposed file path:", ProposedFilePath

    If ProposedFilePath = ConfirmedFilePath Then
        OneDriveLocalFilePath_WriteDebuggingLog Log, 3, "File path has already been confirmed."
        OneDriveLocalFilePath_FileExists = True
        Exit Function
    End If

    If ExistingFile(ProposedFilePath) Then
        ConfirmedFilePath = ProposedFilePath
        ExistsCount = ExistsCount + 1
        OneDriveLocalFilePath_WriteDebuggingLog Log, 3, "File path exists."
        OneDriveLocalFilePath_FileExists = True
    Else
        OneDriveLocalFilePath_WriteDebuggingLog Log, 3, "File path does not exist."
    End If

End Function

Private Sub OneDriveLocalFilePath_WriteDebuggingLog( _
        ByRef Log As String, _
        Optional ByVal Indent As Long, _
        Optional ByVal Message1 As String, _
        Optional ByVal Message2 As String _
    )
' Logs message to debugging log. Internal use only.

    Const IndentSpace As Long = 2
    Const SecondMessagePosition As Long = 55

    Dim SpaceCount As Long

    #If Not Debugging Then
        Exit Sub
    #End If

    If Len(Message1) = 0 Then
        Log = Log & vbCrLf
    Else
        If Len(Message2) > 0 Then
            SpaceCount = SecondMessagePosition - ((Indent * 2) + Len(Message1) + 1)
            If SpaceCount > -1 Then
                Message2 = Space(SpaceCount) & Message2
            Else
                Message2 = Message2
            End If
        End If
        If Len(Log) > 0 Then
            Log = Log & vbCrLf
        End If
        Log = Log & Space(Indent * IndentSpace) & Message1 & Message2
    End If

End Sub

Feedback

Question, correction, or comment? Let us know.