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