ThisWorkbook.FullName returns a URL after syncing with OneDrive. I want the file path on disk

Question

I have a workbook on OneDrive. Usually, ThisWorkbook.FullName returns a path on disk:

c:\Users\MyName\OneDrive - MyCompany\BlaBla\MyWorkbook 09-21-17.xlsb

But after a set of operation in VBA where I manually save the file to a backup folder and rename the current file with a new date, OneDrive syncs and ThisWorkbook.FullName returns a URL:

https://mycompany.sharepoint.com/personal/MyName_Company_com/Documents/mycompany/Apps/BlaBla/MyWorkbook 10-21-17.xlsb

I need the path to disk, even when ThisWorkbook.FullName returns a URL.

If I wanted to hack something together, I could save the path before my operations, but I want to be able to retrieve the disk path at any time.

I've seen some procedures other people have hacked together, like this one, but it more or less just reformats the URL into a path on disk. Doing this isn't reliable as the URL path and the disk path don't always have the same directory structure (see the reformatting done in the linked procedure compared to the directory structures I give as examples above).

Is there a solid, direct, way of returning the path on disk of the Workbook, even if it's syncing online and ThisWorkbook.FullName is returning a URL?

Answer 1

Here's a solution for this problem. The assignment of Sharepoint libraries to local mountpoints is stored in the registry, the following function will convert the URL to a local filename. I edited this to incorporate RMK's suggestions:

Function GetLocalFile(wb As Workbook) As String
    ' Set default return
    GetLocalFile = wb.FullName

    Const HKEY_CURRENT_USER = &H80000001

    Dim strValue As String

    Dim objReg As Object: Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    Dim strRegPath As String: strRegPath = "Software\SyncEngines\Providers\OneDrive\"
    Dim arrSubKeys() As Variant
    objReg.EnumKey HKEY_CURRENT_USER, strRegPath, arrSubKeys

    Dim varKey As Variant
    For Each varKey In arrSubKeys
        ' check if this key has a value named "UrlNamespace", and save the value to strValue
        objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "UrlNamespace", strValue

        ' If the namespace is in FullName, then we know we have a URL and need to get the path on disk
        If InStr(wb.FullName, strValue) > 0 Then
            Dim strTemp As String
            Dim strCID As String
            Dim strMountpoint As String
        
            ' Get the mount point for OneDrive
            objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "MountPoint", strMountpoint
        
            ' Get the CID
            objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "CID", strCID
        
            ' strip off the namespace and CID
            strTemp = Right(wb.FullName, Len(wb.FullName) - Len(strValue & "/" & strCID))
        
            ' replace all forward slashes with backslashes
            GetLocalFile = strMountpoint & Replace(strTemp, "/", "\")
            Exit Function
        End If
    Next
End Function

Answer 2

https://answers.microsoft.com/en-us/msoffice/forum/all/online-path-returned-rather-than-local-path/2ea9970d-383b-4893-afab-38041fee65fe

This did the trick for me. No extra code

Open the OneDrive app settings > go to the Office tab > untick "Use Office applications to sync Office files that I open", then reopen your workbook

Answer 3

This is corrected and restyled code from beerockxs. It works on my machine, but I'm not sure how well it'll work on other setups. If others could test, that would be great. I'll be marking beerockxs answer at the solution.

Function GetLocalFile(wb As Workbook) As String
    ' Set default return
    GetLocalFile = wb.FullName
    
    Const HKEY_CURRENT_USER = &H80000001

    Dim strValue As String
    
    Dim objReg As Object: Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    Dim strRegPath As String: strRegPath = "Software\SyncEngines\Providers\OneDrive\"
    Dim arrSubKeys() As Variant
    objReg.EnumKey HKEY_CURRENT_USER, strRegPath, arrSubKeys
    
    Dim varKey As Variant
    For Each varKey In arrSubKeys
        ' check if this key has a value named "UrlNamespace", and save the value to strValue
        objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "UrlNamespace", strValue
    
        ' If the namespace is in FullName, then we know we have a URL and need to get the path on disk
        If InStr(wb.FullName, strValue) > 0 Then
            Dim strTemp As String
            Dim strCID As String
            Dim strMountpoint As String
            
            ' Get the mount point for OneDrive
            objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "MountPoint", strMountpoint
            
            ' Get the CID
            objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "CID", strCID
            
            ' Add a slash, if the CID returned something
            If strCID <> vbNullString Then
                strCID = "/" & strCID
            End If

            ' strip off the namespace and CID
            strTemp = Right(wb.FullName, Len(wb.FullName) - Len(strValue & strCID))
            
            ' replace all forward slashes with backslashes
            GetLocalFile = strMountpoint & Replace(strTemp, "/", "\")
            Exit Function
        End If
    Next
End Function

Answer 4

Sub get_folder_path()

'early binding
Dim fso As FileSystemObject
Set fso = New FileSystemObject

'late binding
'Dim fso As Object
'Set fso = CreateObject("Scripting.FileSystemObject")

Dim folder As String
folder = fso.GetAbsolutePathName(ThisWorkbook.Name)
Debug.Print (folder)

Answer 5

EDIT:

This answer is now outdated and the conclusions from this post are incomplete. Please look at this solution instead!

---

I have now looked through a bunch of solutions for this problem on the web, including various StackOverflow threads and none of them work for all the different kinds of OneDrive folders/accounts.

Here is a short summary of my tests of the solutions in this thread:

@RMK's solution only works for the personal OneDrive folder

@beerockxs's solution also only works for the personal OneDrive folder

@Danny's solution only works in very rare cases, for me it never worked

@Henrik Bøgelund's solution didn't work

@Erik van der Neut's solution worked in most cases, but in case of a private OneDrive it introduced one extra "\" into the path. This can easily be fixed, but also, it doesn't work if the synchronized folder is not at the base of the folder hierarchy in the online file structure. In that case, extra path parts exist in the WebPath which are carried into the local path making it invalid.

The following function will work in most cases, for a universal solution, please look at this answer.

Public Function GetLocalPath(ByVal Path As String) As String
    Const HKCU = &H80000001
    Dim objReg As Object, rPath As String, subKeys(), subKey
    Dim urlNamespace As String, mountPoint As String, secPart As String
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\." & _
                           "\root\default:StdRegProv")
    rPath = "Software\SyncEngines\Providers\OneDrive\"
    objReg.EnumKey HKCU, rPath, subKeys
    For Each subKey In subKeys
        objReg.GetStringValue HKCU, rPath & subKey, "UrlNamespace", urlNamespace
        If InStr(Path, urlNamespace) > 0 Then
            objReg.GetStringValue HKCU, rPath & subKey, "MountPoint", mountPoint
            secPart = Replace(Mid(Path, Len(urlNamespace)), "/", "\")
            Path = mountPoint & secPart
            Do Until Dir(Path, vbDirectory) <> "" Or InStr(2, secPart, "\") = 0
                secPart = Mid(secPart, InStr(2, secPart, "\"))
                Path = mountPoint & secPart
            Loop
            Exit For
        End If
    Next
    GetLocalPath = Path
End Function