The OneDrive Nightmare Continues: ThisWorkbook.Path and ThisWorkbook.FullName

Kevin Jones 7,265 Reputation points Volunteer Moderator
2024-01-25T07:46:09+00:00

I posted here about my OneDrive backup everything nightmare. Another bad dream has reared it's ugliness in VBA land: ThisWorkbook.Path and ThisWorkbook.FullName.

For some reason I 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, ThisWorkbook.FullName value when opened from any location other than a OneDrive shared folder:

C:\Users\Public\Just Another Workbook.xlsx

But, 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\Kevin Jones\OneDrive - Data Automation Professionals\Just Another Workbook.xlsx

Right off the bat it's painfully obvious that the URL is absolutely useless to anyone and everyone. One of the most common automation tasks that use ThisWorkbook.FullName or ThisWorkbook.Path is to navigate around inside the folder in which the workbook is located. 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? I have no idea.

The whole idea of sharing folders and files on a local drive is so that they can be used the same way as if they were in a non-shared folder. 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. So what were the Microsoft engineers thinking by exposing the URL versus the local path? Anyone have a clue?

A lot of people have said to turn off this 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. This StackOverflow thread got pretty 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. I did find one possible solution in the StackOverflow thread that showed promise - I reworked it so that it worked in as many scenarios as I could find. I'm posting it below.

But, before we get to that, a message to Microsoft: Please refrain from serving up URLs in ThisWorkbook.FullName and ThisWorkbook.Path when the workbook is stored or opened on a local drive. It serves no purpose other than to annoy us and make our lives more difficult. It's also not reality as the workbook is, in fact, located on the local drive in a local folder - that's from where Excel opens it and saves it. Keep the URL an internal thing (I realize it's needed for real time collaboration) and, if you actually believe that someone out here can use it, add a new ThisWorkbook property such as SharedURL.

Below is the routine for getting the local path as it should be returned in FullName. It's been tested on multiple machines, Windows 10 and 11, and Sharepoint and OneDrive shared folders. Post to this thread if you make any improvements or fix any issues.

Public Function OneDriveLocalFilePath( _

        Optional ByRef OneDriveFilePath As String _

    ) 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.

    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 URLNamespace As String

    Dim Path1 As String

    Dim Path2 As String

    Dim Directories As Variant

    Dim ParentDirectory As String

    ' Default to the full name property of ThisWorkbook

    If Len(OneDriveFilePath) = 0 Then

        OneDriveFilePath = ThisWorkbook.FullName

    End If

    ' Deterimine 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")

        ' Enumerate the key HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive

        If WinMgmtS.EnumKey(&H80000001, "SOFTWARE\SyncEngines\Providers\OneDrive", RegistryKeys, Types) = 0 Then

            For Each RegistryKey In RegistryKeys

                ' Each key has three interesting values:

                '

                '   CID - Some hash code sometimes used in the path

                '   URLNameSpace - The URL to a parent directory in the cloud

                '   MountPoint - The local path OneDrive uses to mirror files found in the URLNameSpace address

                CID = vbNullString

                MountPoint = vbNullString

                URLNamespace = vbNullString

                ProposedFilePath = vbNullString

                ConfirmedFilePath = vbNullString

                On Error Resume Next

                CID = WScript.RegRead("HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive" & RegistryKey & "\CID")

                MountPoint = WScript.RegRead("HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive" & RegistryKey & "\MountPoint")

                URLNamespace = WScript.RegRead("HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive" & RegistryKey & "\URLNamespace")

                On Error GoTo 0

                ' It's not always clear how for down the folder tree the URL and the mount point go so the file's parent is

            ' pulled from the OneDrivePath so that it can be compared with and without

                Directories = Split(OneDriveFilePath, "/")

                ParentDirectory = Directories(UBound(Directories) - 1)

                ' Remove any trailing slash from the URL name space

                If Right(URLNamespace, 1) = "/" Then

                    URLNamespace = Left(URLNamespace, Len(URLNamespace) - 1)

                End If

                ' Build two paths to test against: one without the CID and one with the CID

                Path1 = URLNamespace & "/"

                Path2 = URLNamespace & "/" & CID & "/"

                ' Try the path without the CID

                If Left(OneDriveFilePath, Len(Path1)) = Path1 Then

                    ' Try building the final local path from the mount point path and the unmatched end of the OneDrive path

                ' and return it if the file exists

                    ProposedFilePath = MountPoint & "" & Replace(Replace(Mid(OneDriveFilePath, Len(Path1) + 1), "/", ""), "%20", Space(1))

                    If ExistingFile(ProposedFilePath) Then

                        ConfirmedFilePath = ProposedFilePath

                        Exit For

                    End If

                    ' Try building the final local path from the mount point path and the unmatched end of the OneDrive path

                ' but without the first folder and return it if the file exists

                    If Right(MountPoint, Len(ParentDirectory)) = ParentDirectory Then

                        ProposedFilePath = Replace(Replace(Mid(OneDriveFilePath, Len(Path1) + 1), "/", ""), "%20", Space(1))

                        ProposedFilePath = Mid(ProposedFilePath, InStr(ProposedFilePath, "") + 1)

                        ProposedFilePath = MountPoint & "" & ProposedFilePath

                        If ExistingFile(ProposedFilePath) Then

                            ConfirmedFilePath = ProposedFilePath

                            Exit For

                        End If

                    End If

                End If

                ' Try building the final local path from the mount point path with the CID attached and the unmatched end

            ' of the OneDrive path and return it if the file exists

                If Left(OneDriveFilePath, Len(Path2)) = Path2 Then

                    ProposedFilePath = Replace(Replace(Mid(OneDriveFilePath, Len(Path2)), "/", ""), "%20", Space(1))

                    ProposedFilePath = Mid(ProposedFilePath, InStr(ProposedFilePath, "") + 1)

                    ProposedFilePath = MountPoint & "" & ProposedFilePath

                    If ExistingFile(ProposedFilePath) Then

                        ConfirmedFilePath = ProposedFilePath

                        Exit For

                    End If

                End If

            Next RegistryKey

        End If

        ' Return the confirmed file path if a valid path was found

        If Len(ConfirmedFilePath) > 0 Then

            Result = ConfirmedFilePath

        Else

            Result = OneDriveFilePath

        End If

    Else

        ' The path is not a URL so return it as-is

        Result = OneDriveFilePath

    End If

    OneDriveLocalFilePath = Result

End Function

Public Function ExistingFile( _

        ByVal FilePath As String _

    ) As Boolean

' Returns True if the file exists, False otherwise. This routine does not use the Dir technique as

' the Dir function resets any current Dir process.

'

' FilePath - Full path to the folder or file to be evaluated.

    Dim Attributes As Long

    On Error Resume Next

    Attributes = GetAttr(FilePath)

    ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0

    Err.Clear

End Function

Kevin

Microsoft 365 and Office | Excel | For business | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments No comments

105 answers

Sort by: Newest
  1. Anonymous
    2024-02-09T11:39:33+00:00

    Actually, when a user is requested to provide a file name that is used by the code for processing there is always the opportunity that it will be entered incorrectly. As in my case the user is asked for a file name to provide information that has been extracted from a PDF on a monthly basis. As the user enters the file name they could leave off the file extension, which is something I was trying to prevent.

    I'll bet you can't wait to move on to something more interesting 😊 You have been a great help, thank you again.

    Was this answer helpful?

    0 comments No comments
  2. Kevin Jones 7,265 Reputation points Volunteer Moderator
    2024-02-08T18:52:51+00:00

    Yes, that is by design. Not that it's a good design ;-)

    Given my own logic that a URL is, in fact, utterly and completely useless to us, returning it as-is doesn't make sense.

    I'm thinking an empty string makes more sense. An error message could work as well since it is a string result.

    How about both!

    Keep in mind that the only real use for this routine is to translate Workbook.FullName into a useful local path. Since ThisWorkbook.FullName, by definition, always refers to the workbook file which should always exist, not finding it can only mean the routine itself has faulty logic which needs to be addressed.

    Kevin


    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.

    '

    ' ReturnFolderPathOnly - Pass True to return the folder path only. This is the equivelant 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.

    Const Debugging As Boolean = True 
    
    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 URLNamespace As String 
    
    Dim LibraryType As String 
    
    Dim URLNameSpaceExtended As String 
    
    Dim LocalPartialPath As String 
    
    Dim PartialPathRootDirectory As String 
    
    Dim LocalPartialPathWithFirstFolder As String 
    
    Dim LocalPartialPathWithoutFirstFolder As String 
    
    Dim Pass As Long 
    
    Dim ExistsCount As Long 
    
    Dim LogWorksheet As Worksheet 
    
    Dim EntryCount As Long 
    
    If Debugging Then 
    
        On Error Resume Next 
    
        Set LogWorksheet = ThisWorkbook.Worksheets("Debugging Log") 
    
        On Error GoTo 0 
    
        If LogWorksheet Is Nothing Then 
    
            Set LogWorksheet = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1)) 
    
            LogWorksheet.Name = "Debugging Log" 
    
        End If 
    
        LogWorksheet.Cells.ClearContents 
    
        LogWorksheet.Columns(1).Font.Name = "Consolas" 
    
        OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 0, "Entering OneDriveLocalFilePath" 
    
    End If 
    
    ' Default to the full name property of ThisWorkbook 
    
    If Len(OneDriveFilePath) = 0 Then 
    
        OneDriveFilePath = ThisWorkbook.FullName 
    
    End If 
    
    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 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 Debugging, LogWorksheet, 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 Debugging, LogWorksheet 
    
                    ' Each key has three values of interest: 
    
                    ' 
    
                    '   CID - Some hash code sometimes used in the path 
    
                    '   URLNameSpace - The URL to a parent directory in the cloud 
    
                    '   MountPoint - The local path OneDrive uses to mirror files found in the URLNameSpace address 
    
                    CID = vbNullString 
    
                    MountPoint = vbNullString 
    
                    URLNamespace = vbNullString 
    
                    ProposedFilePath = vbNullString 
    
                    On Error Resume Next 
    
                    CID = WScript.RegRead(RegistryPath & RegistryKey & "\CID") 
    
                    MountPoint = WScript.RegRead(RegistryPath & RegistryKey & "\MountPoint") 
    
                    URLNamespace = WScript.RegRead(RegistryPath & RegistryKey & "\URLNamespace") 
    
                    LibraryType = WScript.RegRead(RegistryPath & RegistryKey & "\LibraryType") 
    
                    On Error GoTo 0 
    
                    EntryCount = EntryCount + 1 
    
                    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 0, "Evaluating registry entry " & EntryCount 
    
                    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "Key:", (RegistryKey) 
    
                    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "CID:", CID 
    
                    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "URLNamespace:", URLNamespace 
    
                    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "MountPoint:", MountPoint 
    
                    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "LibraryType:", LibraryType 
    
                    ' Remove any trailing slash from the URL name space 
    
                    If Right(URLNamespace, 1) = "/" Then 
    
                        URLNamespace = Left(URLNamespace, Len(URLNamespace) - 1) 
    
                    End If 
    
                    ' Determine the extended URL name space which may or may not include the CID 
    
                    If Len(CID) = 0 Then 
    
                        URLNameSpaceExtended = URLNamespace 
    
                    Else 
    
                        URLNameSpaceExtended = URLNamespace & "/" & CID 
    
                        If Left(OneDriveFilePath, Len(URLNameSpaceExtended)) <> URLNameSpaceExtended Then 
    
                            URLNameSpaceExtended = URLNamespace 
    
                        End If 
    
                    End If 
    
                    ' Looking for a local file path only if the base of the path being evaluated matches the extended URL name space 
    
                    If Left(OneDriveFilePath, Len(URLNameSpaceExtended)) = URLNameSpaceExtended Then 
    
                        LocalPartialPath = Mid(OneDriveFilePath, Len(URLNameSpaceExtended) + 2) 
    
                        ' It's not always clear if the first directory in the partial path is used locally, it may be a firectory only in the cloud to distinguish directories shared by others 
    
                        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 
    
                            ' Build two local partial paths: one with the first folder after the mount point, and the second without the first folder after the mount point 
    
                            LocalPartialPathWithFirstFolder = Replace(Replace(Mid(OneDriveFilePath, Len(URLNameSpaceExtended) + 2), "/", "\"), "%20", Space(1)) 
    
                            LocalPartialPathWithoutFirstFolder = Mid(LocalPartialPathWithFirstFolder, InStr(LocalPartialPathWithFirstFolder, "\") + 1) 
    
                            If LocalPartialPathWithFirstFolder = LocalPartialPathWithoutFirstFolder Then 
    
                                LocalPartialPathWithFirstFolder = vbNullString 
    
                            End If 
    
                            OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "Local partial path without first folder:", LocalPartialPathWithoutFirstFolder 
    
                            OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "Local partial path with first folder:", LocalPartialPathWithFirstFolder 
    
                            If OneDriveLocalFilePath\_FileExists(MountPoint & "\" & LocalPartialPathWithoutFirstFolder, ConfirmedFilePath, ExistsCount, LogWorksheet, Debugging) Then Exit For 
    
                            If Len(LocalPartialPathWithFirstFolder) > 0 Then 
    
                                If OneDriveLocalFilePath\_FileExists(MountPoint & "\" & LocalPartialPathWithFirstFolder, ConfirmedFilePath, ExistsCount, LogWorksheet, Debugging) Then Exit For 
    
                            End If 
    
                        Else 
    
                            If Pass = 2 Then 
    
                                OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "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 
    
                    Else 
    
                        OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "URL name space does not match base of OneDrive path" 
    
                    End If 
    
                Next RegistryKey 
    
                ' Return the confirmed file path if a valid path was found 
    
                If Len(ConfirmedFilePath) > 0 Then 
    
                    If ReturnFolderPathOnly Then 
    
                        Result = Left(ConfirmedFilePath, InStrRev(ConfirmedFilePath, "\") - 1) 
    
                    Else 
    
                        Result = ConfirmedFilePath 
    
                    End If 
    
                Else 
    
                    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet 
    
                    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "No local path was found" 
    
                End If 
    
            Else 
    
                OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 0, "No registry entries were found" 
    
                Result = OneDriveFilePath 
    
            End If 
    
            If ExistsCount < 2 Then Exit For 
    
            If Pass = 1 Then 
    
                OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet 
    
                OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 0, "More than one existing file was found in the first pass" 
    
                OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 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 
    
        Result = OneDriveFilePath 
    
    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 Debugging, LogWorksheet 
    
    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "OneDrive result: " & Result 
    
    If Debugging Then 
    
        LogWorksheet.Columns(1).EntireColumn.AutoFit 
    
    End If 
    
    OneDriveLocalFilePath = Result 
    

    End Function

    Private Function OneDriveLocalFilePath_FileExists( _

        ByRef ProposedFilePath As String, \_ 
    
        ByRef ConfirmedFilePath As String, \_ 
    
        ByRef ExistsCount As Long, \_ 
    
        ByVal LogWorksheet As Worksheet, \_ 
    
        ByVal Debugging As Boolean \_ 
    
    ) As Boolean 
    

    ' Tests if file path exists. Internal use only.

    OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "Checking proposed file path", ProposedFilePath 
    
    If ProposedFilePath = ConfirmedFilePath Then 
    
        OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "File path has already been confirmed" 
    
        Exit Function 
    
    End If 
    
    If ExistingFile(ProposedFilePath) Then 
    
        ConfirmedFilePath = ProposedFilePath 
    
        ExistsCount = ExistsCount + 1 
    
        OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "File path exists" 
    
    Else 
    
        OneDriveLocalFilePath\_WriteDebuggingLog Debugging, LogWorksheet, 1, "File path does not exist" 
    
    End If 
    

    End Function

    Private Sub OneDriveLocalFilePath_WriteDebuggingLog( _

        ByVal Debugging As Boolean, \_ 
    
        ByVal LogWorksheet As Worksheet, \_ 
    
        Optional ByVal Indent As Long, \_ 
    
        Optional ByVal Message1 As String, \_ 
    
        Optional ByVal Message2 As String \_ 
    
    ) 
    

    ' Logs message to debugging log worksheet. Internal use only.

    Const IndentSpace As Long = 2 
    
    Const SecondMessagePosition As Long = 44 
    
    Dim SpaceCount As Long 
    
    If Not Debugging Then Exit Sub 
    
    If Len(Message1) = 0 Then 
    
        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = Space(1) 
    
    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 
    
        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = Space(Indent \* IndentSpace) & Message1 & Message2 
    
    End If 
    

    End Sub

    Public Function ExistingFile( _

        ByVal FilePath As String \_ 
    
    ) As Boolean 
    

    ' Returns True if the file exists, False otherwise. This routine does not use the Dir technique as

    ' the Dir function resets any current Dir process.

    '

    ' FilePath - Full path to the folder or file to be evaluated.

    Dim Attributes As Long 
    
    On Error Resume Next 
    
    Attributes = GetAttr(FilePath) 
    
    ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0 
    
    Err.Clear 
    

    End Function

    Was this answer helpful?

    2 people found this answer helpful.
    0 comments No comments
  3. Anonymous
    2024-02-07T20:46:46+00:00

    Kevin,

    Thank you for sending out this update. I will try it out within the next couple of days.

    I found another issue for which I created a workaround for in my code. If I enter a non-existing file name your code returns an https address rather than an error.

    Was this answer helpful?

    0 comments No comments
  4. Kevin Jones 7,265 Reputation points Volunteer Moderator
    2024-02-07T09:05:42+00:00

    The code above had some issues. The most egregious one being unable to work in a subfolder. The following code addresses this issue and some others. It's basically a rewrite of the earlier version.

    Kevin


    Public Function OneDriveLocalFilePath( _

        Optional ByRef OneDriveFilePath As String, \_ 
    
        Optional ByVal ReturnFolderPathOnly 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.

    Const Debugging As Boolean = False 
    
    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 URLNamespace As String 
    
    Dim URLNameSpaceExtended As String 
    
    Dim LocalPartialPath As String 
    
    Dim PartialPathRootDirectory As String 
    
    Dim LocalPartialPathWithFirstFolder As String 
    
    Dim LocalPartialPathWithoutFirstFolder As String 
    
    Dim Pass As Long 
    
    Dim ExistsCount As Long 
    
    Dim LogWorksheet As Worksheet 
    
    Dim EntryCount As Long 
    
    If Debugging Then 
    
        On Error Resume Next 
    
        Set LogWorksheet = ThisWorkbook.Worksheets("Debugging Log") 
    
        On Error GoTo 0 
    
        If LogWorksheet Is Nothing Then 
    
            Set LogWorksheet = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1)) 
    
            LogWorksheet.Name = "Debugging Log" 
    
        End If 
    
        LogWorksheet.Cells.ClearContents 
    
        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "Entering OneDriveLocalFilePath" 
    
    End If 
    
    ' Default to the full name property of ThisWorkbook 
    
    If Len(OneDriveFilePath) = 0 Then 
    
        OneDriveFilePath = ThisWorkbook.FullName 
    
    End If 
    
    If Debugging Then 
    
        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "OneDrive file path: " & OneDriveFilePath 
    
    End If 
    
    ' Deterimine 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 
    
            If Debugging Then 
    
                LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "Evaluating registry entries in 'HKEY\_CURRENT\_USER\SOFTWARE\SyncEngines\Providers\OneDrive'" 
    
            End If 
    
            ' Enumerate the key HKEY\_CURRENT\_USER\SOFTWARE\SyncEngines\Providers\OneDrive 
    
            If WinMgmtS.EnumKey(&H80000001, "SOFTWARE\SyncEngines\Providers\OneDrive", RegistryKeys, Types) = 0 Then 
    
                EntryCount = 0 
    
                For Each RegistryKey In RegistryKeys 
    
                    If Debugging Then 
    
                        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = " " 
    
                    End If 
    
                    ' Each key has three values of interest: 
    
                    ' 
    
                    '   CID - Some hash code sometimes used in the path 
    
                    '   URLNameSpace - The URL to a parent directory in the cloud 
    
                    '   MountPoint - The local path OneDrive uses to mirror files found in the URLNameSpace address 
    
                    CID = vbNullString 
    
                    MountPoint = vbNullString 
    
                    URLNamespace = vbNullString 
    
                    ProposedFilePath = vbNullString 
    
                    On Error Resume Next 
    
                    CID = WScript.RegRead("HKEY\_CURRENT\_USER\SOFTWARE\SyncEngines\Providers\OneDrive\" & RegistryKey & "\CID") 
    
                    MountPoint = WScript.RegRead("HKEY\_CURRENT\_USER\SOFTWARE\SyncEngines\Providers\OneDrive\" & RegistryKey & "\MountPoint") 
    
                    URLNamespace = WScript.RegRead("HKEY\_CURRENT\_USER\SOFTWARE\SyncEngines\Providers\OneDrive\" & RegistryKey & "\URLNamespace") 
    
                    On Error GoTo 0 
    
                    If Debugging Then 
    
                        EntryCount = EntryCount + 1 
    
                        'If EntryCount = 8 Then Stop 
    
                        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "Evaluating registry entry " & EntryCount 
    
                        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  Key:                                     " & RegistryKey 
    
                        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  CID:                                     " & CID 
    
                        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  URLNamespace:                            " & URLNamespace 
    
                        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  MountPoint:                              " & MountPoint 
    
                    End If 
    
                    ' Remove any trailing slash from the URL name space 
    
                    If Right(URLNamespace, 1) = "/" Then 
    
                        URLNamespace = Left(URLNamespace, Len(URLNamespace) - 1) 
    
                    End If 
    
                    ' Determine the extended URL name space which may or may not include the CID 
    
                    If Len(CID) = 0 Then 
    
                        URLNameSpaceExtended = URLNamespace 
    
                    Else 
    
                        URLNameSpaceExtended = URLNamespace & "/" & CID 
    
                        If Left(OneDriveFilePath, Len(URLNameSpaceExtended)) <> URLNameSpaceExtended Then 
    
                            URLNameSpaceExtended = URLNamespace 
    
                        End If 
    
                    End If 
    
                    ' Looking for a local file path only if the base of the path being evaluated matches the extended URL name space 
    
                    If Left(OneDriveFilePath, Len(URLNameSpaceExtended)) = URLNameSpaceExtended Then 
    
                        LocalPartialPath = Mid(OneDriveFilePath, Len(URLNameSpaceExtended) + 2) 
    
                        ' It's not always clear if the first directory in the partial path is used locally, it may be a firectory only in the cloud to distinguish directories shared by others 
    
                        If InStr(LocalPartialPath, "/") > 0 Then 
    
                            PartialPathRootDirectory = Left(LocalPartialPath, InStr(LocalPartialPath, "/") - 1) 
    
                        Else 
    
                            PartialPathRootDirectory = vbNullString 
    
                        End If 
    
                        If Pass = 1 Or Pass = 2 And Right(MountPoint, Len(PartialPathRootDirectory)) = PartialPathRootDirectory Then 
    
                            ' Build two local partial paths: one with the first folder after the mount point, and the second without the first folder after the mount point 
    
                            LocalPartialPathWithFirstFolder = Replace(Replace(Mid(OneDriveFilePath, Len(URLNameSpaceExtended) + 2), "/", "\"), "%20", Space(1)) 
    
                            LocalPartialPathWithoutFirstFolder = Mid(LocalPartialPathWithFirstFolder, InStr(LocalPartialPathWithFirstFolder, "\") + 1) 
    
                            If LocalPartialPathWithFirstFolder = LocalPartialPathWithoutFirstFolder Then 
    
                                LocalPartialPathWithFirstFolder = vbNullString 
    
                            End If 
    
                            If Debugging Then 
    
                                LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  Local partial path without first folder: " & LocalPartialPathWithoutFirstFolder 
    
                                LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  Local partial path with first folder:    " & LocalPartialPathWithFirstFolder 
    
                            End If 
    
                            If OneDriveLocalFilePath\_FileExists(MountPoint & "\" & LocalPartialPathWithoutFirstFolder, ConfirmedFilePath, ExistsCount, LogWorksheet, Debugging) Then Exit For 
    
                            If Len(LocalPartialPathWithFirstFolder) > 0 Then 
    
                                If OneDriveLocalFilePath\_FileExists(MountPoint & "\" & LocalPartialPathWithFirstFolder, ConfirmedFilePath, ExistsCount, LogWorksheet, Debugging) Then Exit For 
    
                            End If 
    
                        Else 
    
                            If Debugging Then 
    
                                If Pass = 2 Then 
    
                                    LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  Right part of directory of mount point does not match the first directory of the partial path" 
    
                                End If 
    
                            End If 
    
                        End If 
    
                    Else 
    
                        If Debugging Then 
    
                            LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  URL name space does not match base of OneDrive path" 
    
                        End If 
    
                    End If 
    
                Next RegistryKey 
    
                ' Return the confirmed file path if a valid path was found 
    
                If Len(ConfirmedFilePath) > 0 Then 
    
                    If ReturnFolderPathOnly Then 
    
                        Result = Left(ConfirmedFilePath, InStrRev(ConfirmedFilePath, "\") - 1) 
    
                    Else 
    
                        Result = ConfirmedFilePath 
    
                    End If 
    
                Else 
    
                    If Debugging Then 
    
                        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "No local path was found" 
    
                    End If 
    
                End If 
    
            Else 
    
                If Debugging Then 
    
                    LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "No registry entries were found" 
    
                End If 
    
                Result = OneDriveFilePath 
    
            End If 
    
            If ExistsCount < 2 Then Exit For 
    
            If Debugging Then 
    
                If Pass = 1 Then 
    
                    LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = " " 
    
                    LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "More than one existing file was found in the first pass" 
    
                    LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "Doing another pass and adding an extra check for a share drive base folder" 
    
                End If 
    
            End If 
    
        Next Pass 
    
    Else 
    
        ' The path is not a URL so return it as-is 
    
        Result = OneDriveFilePath 
    
    End If 
    
    If ExistsCount = 0 Then 
    
        Result = OneDriveFilePath 
    
    End If 
    
    If Debugging Then 
    
        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = " " 
    
        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "OneDrive result: " & Result 
    
        LogWorksheet.Columns(1).Font.Name = "Consolas" 
    
        LogWorksheet.Columns(1).EntireColumn.AutoFit 
    
    End If 
    
    OneDriveLocalFilePath = Result 
    

    End Function

    Private Function OneDriveLocalFilePath_FileExists( _

        ByRef ProposedFilePath As String, \_ 
    
        ByRef ConfirmedFilePath As String, \_ 
    
        ByRef ExistsCount As Long, \_ 
    
        ByVal LogWorksheet As Worksheet, \_ 
    
        ByVal Debugging As Boolean \_ 
    
    ) As Boolean 
    
    If Debugging Then 
    
        LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  Checking proposed file path:             " & ProposedFilePath 
    
    End If 
    
    If ProposedFilePath = ConfirmedFilePath Then 
    
        If Debugging Then 
    
            LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  File path has already been confirmed" 
    
        End If 
    
        Exit Function 
    
    End If 
    
    If ExistingFile(ProposedFilePath) Then 
    
        ConfirmedFilePath = ProposedFilePath 
    
        ExistsCount = ExistsCount + 1 
    
        If Debugging Then 
    
            LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  File path exists" 
    
        Else 
    
            OneDriveLocalFilePath\_FileExists = True 
    
        End If 
    
    Else 
    
        If Debugging Then 
    
            LogWorksheet.Cells(Application.CountA(LogWorksheet.Columns(1)) + 1, 1).Value = "  File path does not exist" 
    
        End If 
    
    End If 
    

    End Function

    Public Function ExistingFile( _

            ByVal FilePath As String _

        ) As Boolean

    ' Returns True if the file exists, False otherwise. This routine does not use the Dir technique as

    ' the Dir function resets any current Dir process.

    '

    ' FilePath - Full path to the folder or file to be evaluated.

        Dim Attributes As Long

        On Error Resume Next

        Attributes = GetAttr(FilePath)

        ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0

        Err.Clear

    End Function

    Was this answer helpful?

    2 people found this answer helpful.
    0 comments No comments
  5. Kevin Jones 7,265 Reputation points Volunteer Moderator
    2024-02-03T20:57:37+00:00

    I didn't include this "helper" routine when I posted the code the second time:

    Public Function ExistingFile( _

            ByVal FilePath As String _

        ) As Boolean

    ' Returns True if the file exists, False otherwise. This routine does not use the Dir technique as

    ' the Dir function resets any current Dir process.

    '

    ' FilePath - Full path to the folder or file to be evaluated.

        Dim Attributes As Long

        On Error Resume Next

        Attributes = GetAttr(FilePath)

        ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0

        Err.Clear

    End Function

    Kevin

    Was this answer helpful?

    0 comments No comments