Excel VBA Get Physical Location, not OneDrive URL

Question

I'm used VBA in excel to create some simple files, that should be saved in the same location as the excel file.

I get the location of the excel file with this:

ActiveWorkbook.Path

The problem is that this always returns the OneDrive URL, like this:

https://d.docs.live.net/641ebe6d8******/Work/Projects.......

What I'm looking for is the physical location on my hard drive.

I've tried closing OneDrive application on my computer, and opening the file from the directory itself, but still the location from above gives me a OneDrive URL.

Any ideas how to get the directory path on my harddrive instead?

Is MyDrive mapped to a path on your disk? – Tarik Jan 08 '21 at 13:17 — Tarik, Jan 08 '21 at 13:17
OneDrive in synced to my C drive is that's what you mean? – Phil Teare Jan 08 '21 at 13:37 — Phil Teare, Jan 08 '21 at 13:37

score 6 · Answer 1 · answered Nov 11 '21 at 14:08

You can use the helper function below to get the physical path of the file, even if it's saved in a OneDrive/Microsoft Teams folder.

It will basically loop through the Windows Registry keys that stores the synced folders paths, and return the one that matches your file URL.

Function GetWorkbookPath(Optional wb As Workbook)
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' Purpose:  Returns a workbook's physical path, even when they are saved in
    '           synced OneDrive Personal, OneDrive Business or Microsoft Teams folders.
    '           If no value is provided for wb, it's set to ThisWorkbook object instead.
    ' Author:   Ricardo Gerbaudo
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    If wb Is Nothing Then Set wb = ThisWorkbook
    
    GetWorkbookPath = wb.Path
    
    If InStr(1, wb.Path, "https://") <> 0 Then
        
        Const HKEY_CURRENT_USER = &H80000001
        Dim objRegistryProvider As Object
        Dim strRegistryPath As String
        Dim arrSubKeys()
        Dim strSubKey As Variant
        Dim strUrlNamespace As String
        Dim strMountPoint As String
        Dim strLocalPath As String
        Dim strRemainderPath As String
        Dim strLibraryType As String
    
        Set objRegistryProvider = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    
        strRegistryPath = "SOFTWARE\SyncEngines\Providers\OneDrive"
        objRegistryProvider.EnumKey HKEY_CURRENT_USER, strRegistryPath, arrSubKeys
        
        For Each strSubKey In arrSubKeys
            objRegistryProvider.GetStringValue HKEY_CURRENT_USER, strRegistryPath & "\" & strSubKey & "\", "UrlNamespace", strUrlNamespace
            If InStr(1, wb.Path, strUrlNamespace) <> 0 Or InStr(1, strUrlNamespace, wb.Path) <> 0 Then
                objRegistryProvider.GetStringValue HKEY_CURRENT_USER, strRegistryPath & "\" & strSubKey & "\", "MountPoint", strMountPoint
                objRegistryProvider.GetStringValue HKEY_CURRENT_USER, strRegistryPath & "\" & strSubKey & "\", "LibraryType", strLibraryType
                
                If InStr(1, wb.Path, strUrlNamespace) <> 0 Then
                    strRemainderPath = Replace(wb.Path, strUrlNamespace, vbNullString)
                Else
                    GetWorkbookPath = strMountPoint
                    Exit Function
                End If
                
                'If OneDrive Personal, skips the GUID part of the URL to match with physical path
                If InStr(1, strUrlNamespace, "https://d.docs.live.net") <> 0 Then
                    If InStr(2, strRemainderPath, "/") = 0 Then
                        strRemainderPath = vbNullString
                    Else
                        strRemainderPath = Mid(strRemainderPath, InStr(2, strRemainderPath, "/"))
                    End If
                End If
                
                'If OneDrive Business, adds extra slash at the start of string to match the pattern
                strRemainderPath = IIf(InStr(1, strUrlNamespace, "my.sharepoint.com") <> 0, "/", vbNullString) & strRemainderPath
                
                strLocalPath = ""
                
                If (InStr(1, strRemainderPath, "/")) <> 0 Then
                    strLocalPath = Mid(strRemainderPath, InStr(1, strRemainderPath, "/"))
                    strLocalPath = Replace(strLocalPath, "/", "\")
                End If
                
                strLocalPath = strMountPoint & strLocalPath
                GetWorkbookPath = strLocalPath
                If Dir(GetWorkbookPath & "\" & wb.Name) <> "" Then Exit Function
            End If
        Next
    End If
    
End Function

I included this solution in my meta-analysis of all of the solutions to this problem. At the time it was written, this was the best performing solution according to my testing. Now, more reliable solutions exist. They are presented [here](https://stackoverflow.com/a/73577057/12287457), together with the meta-analysis. — GWD, Sep 05 '22 at 10:22

score 4 · Accepted Answer · answered Jan 08 '21 at 13:41

4

Solution is a OneDrive Setting.

Unchecking "Use Office applications to sunc Office files that I open" makes it use the local directory. This effect is true even when OneDrive app is closed on my computer.

answered Jan 08 '21 at 13:41

Phil Teare

417
1
6
14

Just learned something today. Thanks Phil! – Tarik Jan 08 '21 at 13:43
Thanks Tarik! A better solution would be to give Excel VBA permission to save to the OneDrive URL, but I cannot find a way to do that. – Phil Teare Jan 08 '21 at 14:09
@PhilTeare if your problem was solved, please don't forget to mark it as answered. ;) – ricardogerbaudo Nov 18 '21 at 02:21
If you are not ready to deactivate the useful feature of live sync to circumvent this problem, you can now use [this solution](https://stackoverflow.com/a/73577057/12287457). – GWD Sep 05 '22 at 11:37

score 1 · Answer 3 · answered May 02 '23 at 16:19

1

Ok, I know this post is old, but I just wanted to let you know I have found an easy workaround:

pth = ThisWorkbook.Path

pth = CStr(Environ("USERPROFILE") & "\OneDrive\") & Right(pth, Len(pth) - Len(Right(pth, InStrRev(pth, "/"))))

answered May 02 '23 at 16:19

XPCS

65
3
12

Excel VBA Get Physical Location, not OneDrive URL

3 Answers3

Linked