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

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 2

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 3

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

Answer 4

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 5

I used Windows a environment variable to solve this problem.

In my example I was using a private OneDrive, but it is fairly simple to change the code to handle OneDrive for Business. The environment variable would then be "OneDriveCommercial" instead of "OneDriveConsumer".

This is my code for converting the OneDrive URL into a local path:

Rem consumer URL to OneDrive root: "https://d.docs.live.net/<64-bit hex value>/"
OneDriveServerURL = "https://d.docs.live.net/"

path = ActiveWorkbook.path
Worksheets("Menu").Range("G6").Value = path

If Left(path, Len(OneDriveServerURL)) = OneDriveServerURL Then
  Rem remove from start to first "/" after server URL
  path = Mid(path, InStr(Len(OneDriveServerURL) + 1, path, "/"))

  Rem replce "/" by "\"
  path = Replace(path, "/", Application.PathSeparator)

  Rem add OneDrive root folder from environment variable
  path = Environ("OneDriveConsumer") + path
End If

Answer 6

If you have a personal OneDrive, use Environ("OneDriveConsumer")

The code: Environ("OneDriveCommercial")+Replace(Right(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - (InStr(ThisWorkbook.FullName, "/Documents/") + 9)),"/","")

"/Documents/" should be standard, but your OneDrive may have a different setup. If so, you will need to replace "/Documents/" (the end of the OneDrive Prefix) with whatever you have. and replace the "9" to be the length of what you have minus 2.

Answer 7

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 8

If you're just trying to do SaveAs, there's literally a Parameter called "Local" that will cause all properties (FullName/Path/etc.) to resolve based on the language of the local machine.

Just add "Local:=True" to the SaveAs call and you'll be good to go.

So in my case I use:

Sub ExportCurrentWorkbook()
 Dim ws As Worksheet
 Set ws = Application.ActiveSheet
 
 Application.ScreenUpdating = False
 ws.Copy

 ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ws.Name & ".csv", xlCSVUTF8, _
 ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges, Local:=True

 ActiveWorkbook.Close SaveChanges = True
 Application.ScreenUpdating = True
   
End Sub

MSDN Reference: https://learn.microsoft.com/en-us/office/vba/api/excel.workbook.saveas

Answer 9

Thanks to beerockxs and RMK for their excellent responses.

I had to make a few minor adjustments to get it to work reliably. For example, in my case a CID value was returned, but the CID was not actually part of the full OneDrive URL. So, because of that, stripping off the number of characters for that broke the local path for me.

As a solution, I'm not stripping off the CID and URL Name Space by counting characters, but instead by doing simple String Replace operations. That way, if you get a CID value back that is not part of the URL, it won't remove anything from the URL for that. It also makes the code a little easier to read.

In my case I need the local root folder of my Excel spreadsheet, so created a simple extra method on top of that as well.

I also added a few simple Mac checks (to avoid this from trying to run on a Mac, as it won't work for that), and added some debug MsgBox calls -- comment those out once you find it works for you as well:

Function GetLocalPath(wb As Workbook) As String

    strLocalFile = GetLocalFile(wb)
    
    ' Remove everything after the last slash to get just the path itself:
    GetLocalPath = Left(strLocalFile, InStrRev(strLocalFile, "\"))
    
    ''''''''''''''' DEBUG '''''''''''''''''''''''''
    MsgBox "Local file:" & vbCrLf & strLocalFile & vbCrLf & vbCrLf & "Local path:" & vbCrLf & GetLocalPath
    ''''''''''''''' DEBUG '''''''''''''''''''''''''

End Function


Function GetLocalFile(wb As Workbook) As String
#If Mac Then
    MsgBox "Sorry, this script only works on Windows."
#Else
    ' Set default return
    GetLocalFile = wb.FullName
    
    Const HKEY_CURRENT_USER = &H80000001

    Dim strUrlNameSpace 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 strUrlNameSpace:
        objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "UrlNamespace", strUrlNameSpace
        
        ' 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, strUrlNameSpace) > 0 Then
            Dim strTemp As String
            Dim strCID As String
            Dim strMountpoint As String
            
            ' Get the mount point for OneDrive, and make sure it ends in "\":
            objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "MountPoint", strMountpoint
            If Right(strMountpoint, 1) <> "\" Then
                strMountpoint = strMountpoint & "\"
            End If
            
            ' Get the CID, and add "/" at the start if any value returned:
            objReg.getStringValue HKEY_CURRENT_USER, strRegPath & varKey, "CID", strCID
            If strCID <> vbNullString Then
                strCID = "/" & strCID
            End If

            ' Replace the URL name space with local mount point:
            strTemp = Replace(wb.FullName, strUrlNameSpace, strMountpoint)
            
            ' Remove CID from the path if the CID is indeed part of it:
            strTemp = Replace(strTemp, strCID, "")
            
            ' Replace any remaining forward slashes with backslashes:
            GetLocalFile = Replace(strTemp, "/", "\")
            
            ''''''''''''''' DEBUG '''''''''''''''''''''''''
            MsgBox "OneDrive URL:" & vbCrLf & wb.FullName & vbCrLf & vbCrLf & "URL Name Space (strUrlNameSpace):" & vbCrLf & strUrlNameSpace & vbCrLf & vbCrLf & "OneDrive Mount Point (strMountpoint):" & vbCrLf & strMountpoint & vbCrLf & vbCrLf & "CID (strCID):" & vbCrLf & strCID & vbCrLf & vbCrLf & "Local file:" & vbCrLf & GetLocalFile
            ''''''''''''''' DEBUG '''''''''''''''''''''''''
            
            Exit Function
        End If
    Next
#End If
End Function

Verified in testing that this now works perfectly, both in OneDrive folders and in regular folders.

Erik