GetLocalPath doesn't work in all cases

[guwidoe]

Hello, I love the work you did with your VBA Libraries!

I recently ran into an issue with my GetLocalPath function, then I remembered yours, gave it a try, and ran into even more issues. The first problem, which only occurred in your function, is that the registry keys you read don't seem to contain information for all of the possible WebPaths. I have these two "Accounts" in my registry, yet only the Business1 one contains a bunch of subkeys, while the Personal one only contains (Standard), so it's completely empty. This is not too big of a surprise, because I'm only logged in on my business account on that machine.

This is a problem, because even if you only have one Business account logged in, there can be at least two (I know of...) different WebPath "roots", one for the "Personal" (Business) OneDrive folder, and one for the "SharePoint" folder. "Personal" (Business) OneDrive "SharePoint" folder

Because you only read one of the possible WebPaths (ServiceEndpointUri), this leaves you with too little information to deal with all possible WebPaths. There is information about the paths in the Registry folder you are checking, but I'm not sure it's enough. I have the keys SPOResourceId -> https://%company_name%online-my.sharepoint.com/ (Personal) TeamSiteSPOResourceId -> https://%company_name%online.sharepoint.com/ (SharePoint)

which contain something like the "roots root" of the two possible WebPaths. But I'm not even sure if reading these would give enough information since the actual SharePoint WebPath has a longer root, something like https://%company_name%online.sharepoint.com/sites/workspaces/ and I don't know if the /sites/workspaces/ is the same in every possible SharePoint WebPath.

This doesn't really matter since I would recommend reading different RegistryKeys anyways, which you know about too I suppose. These are of course located at \HKEY_CURRENT_USER\Software\SyncEngines\Providers\OneDrive Here, reading the UrlNamespace and MountPoint subkeys of all the subfolders gives almost all the necessary information to construct the right local paths, but there is still a little annoyance, which is where I ran into the problem in the first place.

That is if the synchronized folder is not at the base of the folder structure on the server, the WebPath will still contain all the server subfolders which do not exist in the local mount, but the UrlNamespace key will still only contain the "root" of the WebPath. Hence, if we construct a LocalPath by replacing the "root" of the WebPath with the MountPoint and fixing the PathSeparators, the "intermediate" folders which are present in the WebPath will still be present in the constructed (wrong) LocalPath.

The only way I can think of to solve this issue would be constructing the WebPath this way and then checking if the folder/file exists and removing intermediate path parts until the path points to a valid folder/file. Of course, this is not very elegant and takes away the feature of also working for nonexistent files/folders.

Maybe you can come up with a better solution, the missing information should be somewhere out there in the registry, shouldn't it?

[cristianbuse]

Hello,

Thanks for raising the issue and for your kind words!

Is there a reason why you would like to convert a web path to a local path for an account that is not logged in? My instinct would be to ignore any logged out accounts to avoid working with files that could go out of sync. However, I definitely want to understand why you need this to work as I have definitely not considered this option.

Based on your answer to the above, I might switch to the SyncEngines path or not but in either case I would like to be able to fix the subfolder issue. As I do not have this issue on my personal or business accounts I could surely use your help with some screenshots of the keys in both the SyncEngines folder and the Software\Microsoft\OneDrive\Accounts\ folder.

Please let me know your thoughts on the first question and if you can help with more info on the keys.

Thanks!

Cristian

[guwidoe]

Hi,

Thanks for your quick reply!

Is there a reason why you would like to convert a web path to a local path for an account that is not logged in?

I think you slightly misunderstood the first problem I mentioned, this is not what I'm trying to do. The mentioned "Personal (Business) OneDrive" folder and the "SharePoint" folder belong to the same account (which is indeed logged in) and still have different WebPath roots.

I can gladly provide a screenshot: (only the company name is censored)

As you can see, by only reading ServiceEndpointUri you only gain knowledge about one of the two possible roots (both associated with the same (logged in) account.

For the logged out personal account, the registry contains nothing, as expected:

Here are some screenshots of the SyncEngines Registry: As you can see, the value of the UrlNamespace key (the root of different WebPaths) can differ quite significantly.

I wrote a test sub that contains all variations of WebPaths I'm currently aware of and just tested a bunch of solutions to the issue I found online. As expected, most of them failed at least some tests. In fact, there was only one solution of like 15 I tested which passed all the tests, and it did so to my great surprise, because it was posted on StackOverflow by a user with a mere 21 reputation. Here is a link: https://stackoverflow.com/a/68963896/12287457

If only works for files or folders that exist and it runs very slowly so I'm sure it can be improved a lot.

After reading his solution it seems the only reason it runs so slow is that he doesn't use the registry to get the information about the local paths but the OneDrive settings file instead. And It overcomes the intermediate path part problem using the Dir function, similar to how I suggested in my original post. I condensed his solution into this relatively short function which is sufficient for me: Note: If only works for files or folders that exist!

Private Function GetLocalPath(path As String) As String
    Const HKEY_CURRENT_USER = &H80000001
    Dim objReg As Object
    Dim regPath As String
    Dim subKeys() As Variant
    Dim subKey As Variant
    Dim strValue As String
    Dim strMountpoint As String
    Dim strSecPart As String

    Static pathSep As String
    If pathSep = "" Then pathSep = Application.PathSeparator

    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    regPath = "Software\SyncEngines\Providers\OneDrive\"
    objReg.EnumKey HKEY_CURRENT_USER, regPath, subKeys

    For Each subKey In subKeys
        objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, _
                            "UrlNamespace", strValue
        If InStr(path, strValue) > 0 Then
            objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, _
                                "MountPoint", strMountpoint
            strSecPart = Replace(Mid(path, Len(strValue)), "/", pathSep)
            GetLocalPath = strMountpoint & strSecPart

            Do Until Dir(GetLocalPath, vbDirectory) <> "" Or _
                     InStr(2, strSecPart, pathSep) = 0
                strSecPart = Mid(strSecPart, InStr(2, strSecPart, pathSep))
                GetLocalPath = strMountpoint & strSecPart
            Loop
            Exit Function
        End If
    Next
    GetLocalPath = path
End Function

EDIT: Of course, the solutions don't work for files that don't exist. I was confused because it does work for files that don't exist at the bottom of the folder hierarchy, for example https://d.docs.live.net/f1189d8c9189d493/test.xlsm would correctly convert to C:\Users\username\OneDrive\test.xlsm

[guwidoe]

I now did further testing and also logged into a personal OneDrive account on my device. It seems the solution I linked doesn't work for personal OneDrive folders, but the one I suggested does work.

I found another solution that does also work for folders that don't exist, however, it has other shortcomings which I pointed out in the comments to the StackOverflow post.

[cristianbuse]

Out of curiosity, if you replace GetOneDriveLocalPath from my repo with the below, does the GetLocalPath work in all cases? I know this is only working for Excel but it could be useful for testing edge cases.

Public Function GetOneDriveLocalPath(ByVal odWebPath As String) As String
    If InStr(1, odWebPath, "https://", vbTextCompare) = 0 Then Exit Function
    '
    Static isSet As Boolean
    Static arrLocal(0 To 1) As String
    Static arrWeb(0 To 1) As String
    Dim i As Long
    Dim tempPath As String
    '
    If Not isSet Then
        arrLocal(0) = Environ$("OneDriveCommercial")
        arrLocal(1) = Environ$("OneDriveConsumer")
        '
        Dim v As Variant
        Dim repaintOn As Boolean: repaintOn = Application.ScreenUpdating
        Dim alertsOn As Boolean: alertsOn = Application.DisplayAlerts
        Dim eventsOn As Boolean: eventsOn = Application.EnableEvents
        '
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        On Error Resume Next
        For Each v In arrLocal
            If LenB(v) > 0 Then
                tempPath = BuildPath(v, "temp.xlsx")
                With Application.Workbooks.Add
                    .SaveAs tempPath, XlFileFormat.xlOpenXMLWorkbook
                    arrWeb(i) = Left$(.FullName, InStrRev(.FullName, "/") - 1)
                    .Close SaveChanges:=False
                    Kill tempPath
                End With
            End If
            i = i + 1
        Next v
        On Error GoTo 0
        If repaintOn Then Application.ScreenUpdating = True
        If alertsOn Then Application.DisplayAlerts = True
        If eventsOn Then Application.EnableEvents = True
        isSet = True
    End If
    '
    For i = LBound(arrWeb) To UBound(arrWeb)
        tempPath = arrWeb(i)
        Dim lo As Long: lo = Len(tempPath)
        If lo > 0 Then
            If Len(odWebPath) > lo Then
                If StrComp(tempPath, Left$(odWebPath, lo), vbTextCompare) = 0 Then
                    GetOneDriveLocalPath = Replace(odWebPath, tempPath, arrLocal(i), , , vbTextCompare)
                    Exit Function
                End If
            End If
        End If
    Next i
End Function

Thanks!

[guwidoe]

Hello,

I tested it and unfortunately, it didn't work in a single case. In all except one case, it returned nothing and in one case it returned the right path but with some wrong PathSeparators.

[cristianbuse]

That's really strange. I was expecting that it works for all cases since it's using Excel's internal logic with no registry 'hack'. Does your solution work where the Excel fails? Could you give me the path(s) where it failed? Thanks!

[guwidoe]

As a side note, Environ$("OneDriveConsumer") returns nothing on my system. After checking all my Environ variables with this script:

Sub AllEnvironVariables()
    Dim strEnviron As String
    Dim VarSplit As Variant
    Dim i As Long
    For i = 1 To 255
        strEnviron = Environ$(i)
        If LenB(strEnviron) = 0& Then GoTo TryNext:
        Debug.Print strEnviron
TryNext:
    Next
End Sub

I have only two OneDrive Environ variables defined, OneDrive and OneDriveCommercial both pointing to the same directory, the one I called "Personal" (Business) OneDrive (C:\Users\Witt-DörringGuidoABC\OneDrive - ABC) in my original post.

My solution works in all cases except if the file/folder doesn't exist.

[guwidoe]

These are the tests I can share, I'm using this test script: (EDIT: Updated the test script)

Sub TestGetLocalPath(TestName As String, oneDrivePath As String, localPath As String)
    If Not GetLocalPath(oneDrivePath) = localPath Then
        Debug.Print vbNewLine & TestName & " ERROR:"
        Debug.Print "URL path: " & oneDrivePath
        Debug.Print "Func ret: " & GetLocalPath(oneDrivePath)
        Debug.Print "act path: " & localPath & vbNewLine
    Else
        Debug.Print TestName & " PASSED"
    End If
End Sub

EDIT: I have now updated my tests so I can share all of them:

TestGetLocalPath "Test Company SharePoint", _
    "https://abconline.sharepoint.com/sites/ACEA/Freigegebene Dokumente/General/2021/04_Working/- Archiv -/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\ABC\ACEA - General\2021\04_Working\- Archiv -\test.xlsm"

TestGetLocalPath "Test2 Company SharePoint", _
    "https://abconline.sharepoint.com/sites/AI/Freigegebene Dokumente/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\ABC\AI - Dokumente\Test\test.xlsm"

TestGetLocalPath "Test3 Company SharePoint, (file that doesn't exist, but in top lvl directory)", _
    "https://abconline.sharepoint.com/sites/workspaces/ntbas/Shared Documents/Test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\ABC\NTB After Sales - Documents\Test.xlsm"

TestGetLocalPath "Test4 Company SharePoint", _
    "https://abconline.sharepoint.com/sites/workspaces/NTB/Shared Documents/100_Business Development/", _
    "C:\Users\Witt-DörringGuidoABC\ABC\NTB - Documents\100_Business Development\"

 TestGetLocalPath "Test Personal Business OneDrive", _
    "https://abconline-my.sharepoint.com/personal/gwitt-doerring_abc_at/Documents/-Test-/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive - ABC\-Test-\test.xlsm"

TestGetLocalPath "Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!)", _
    "https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Beispiel import.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Beispiel import.xlsm"

TestGetLocalPath "Test Private OneDrive folder", _
    "https://d.docs.live.net/f1189d8c9189d493/Testfolder_toplvl/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Testfolder_toplvl\test.xlsm"

TestGetLocalPath "Test2 Personal Business OneDrive shared by someone else (nonexistant folder)", _
    "https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Test/", _
    "C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Test\"

TestGetLocalPath "Test3 Private SharePoint shared by someone else (secone level folder mount)", _
    "https://d.docs.live.net/5cfc6adc55f2ae2b/FirstLevel/SecondLevel/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\SecondLevel\test.xlsm"

TestGetLocalPath "Test4 Private SharePoint shared by someone else (second level folder mount with tricky name)", _
    "https://d.docs.live.net/5cfc6adc55f2ae2b/Test/Test/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\test.xlsm"

Results with your latest function:

Test Company SharePoint ERROR:
URL path: https://abconline.sharepoint.com/sites/ACEA/Freigegebene Dokumente/General/2021/04_Working/- Archiv -/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\ABC\ACEA - General\2021\04_Working\- Archiv -\test.xlsm

Test2 Company SharePoint ERROR:
URL path: https://abconline.sharepoint.com/sites/AI/Freigegebene Dokumente/Test/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\ABC\AI - Dokumente\Test\test.xlsm

Test3 Company SharePoint, (file that doesn't exist, but in top lvl directory) ERROR:
URL path: https://abconline.sharepoint.com/sites/workspaces/ntbas/Shared Documents/Test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\ABC\NTB After Sales - Documents\Test.xlsm

Test4 Company SharePoint ERROR:
URL path: https://abconline.sharepoint.com/sites/workspaces/NTB/Shared Documents/100_Business Development/
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\ABC\NTB - Documents\100_Business Development\

Test Personal Business OneDrive ERROR:
URL path: https://abconline-my.sharepoint.com/personal/gwitt-doerring_abc_at/Documents/-Test-/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive - ABC/-Test-/test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive - ABC\-Test-\test.xlsm

Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!) ERROR:
URL path: https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Beispiel import.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Beispiel import.xlsm

Test Private OneDrive folder ERROR:
URL path: https://d.docs.live.net/f1189d8c9189d493/Testfolder_toplvl/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Testfolder_toplvl\test.xlsm

Test2 Personal Business OneDrive shared by someone else (nonexistant folder) ERROR:
URL path: https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Test/
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Test\

Test3 Private SharePoint shared by someone else (secone level folder mount) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/FirstLevel/SecondLevel/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\SecondLevel\test.xlsm

Test4 Private SharePoint shared by someone else (second level folder mount with tricky name) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/Test/Test/Test/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\test.xlsm

Results with my function:

Test Company SharePoint PASSED
Test2 Company SharePoint PASSED
Test3 Company SharePoint, (file that doesn't exist, but in top lvl directory) PASSED
Test4 Company SharePoint PASSED
Test Personal Business OneDrive PASSED
Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!) PASSED:
Test Private OneDrive folder PASSED

Test2 Personal Business OneDrive shared by someone else (nonexistant folder) ERROR:
URL path: https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Test/
Func ret: C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\
act path: C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Test\

Test3 Private SharePoint shared by someone else (secone level folder mount) PASSED
Test4 Private SharePoint shared by someone else (second level folder mount with tricky name) PASSED

[cristianbuse]

This (GetOneDriveLocalPath) seems to be passing all tests but I don't like that it creates temporary files (even if only once) and that it only works in Excel:

Option Explicit

Private Type OneDriveProvider
    UrlNamespace As String
    MountPoint As String
    isSet As Boolean
End Type
Private Type OneDriveProviders
    arr() As OneDriveProvider
    pCount As Long
    isSet As Boolean
End Type

Public Function GetOneDriveLocalPath(ByVal odWebPath As String) As String
    If InStr(1, odWebPath, "https://", vbTextCompare) = 0 Then Exit Function
    '
    Static providers As OneDriveProviders
    Static isSet As Boolean
    Dim i As Long
    '
    If LenB(odWebPath) = 0 Then Exit Function
    If Not providers.isSet Then
        providers = GetProviders()
        providers.isSet = True
    End If
    For i = 1 To providers.pCount
        With providers.arr(i)
            If StrComp(Left$(odWebPath, Len(.UrlNamespace)), .UrlNamespace, vbTextCompare) = 0 Then
                If Not .isSet Then SetProvider providers.arr(i)
                GetOneDriveLocalPath = BuildPath(.MountPoint, Replace(odWebPath, .UrlNamespace, vbNullString))
                Exit Function
            End If
        End With
    Next i
End Function

Private Function GetProviders() As OneDriveProviders
    Const HKEY_CURRENT_USER = &H80000001
    Const regPath As String = "Software\SyncEngines\Providers\OneDrive\"
    Dim objReg As Object
    Dim subKeys() As Variant
    Dim subKey As Variant
    Dim i As Long
    '
    On Error GoTo CleanExit
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.EnumKey HKEY_CURRENT_USER, regPath, subKeys
    '
    With GetProviders
        .pCount = UBound(subKeys) - LBound(subKeys) + 1
        ReDim .arr(1 To .pCount)
        i = 1
        For Each subKey In subKeys
            With .arr(i)
                objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, "UrlNamespace", .UrlNamespace
                objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, "MountPoint", .MountPoint
            End With
            i = i + 1
        Next subKey
    End With
CleanExit:
End Function

Private Sub SetProvider(ByRef provider As OneDriveProvider)
    Dim repaintOn As Boolean: repaintOn = Application.ScreenUpdating
    Dim alertsOn As Boolean: alertsOn = Application.DisplayAlerts
    Dim eventsOn As Boolean: eventsOn = Application.EnableEvents
    Dim tempPath As String
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    '
    tempPath = BuildPath(provider.MountPoint, "temp.xlsx")
    If Not IsFile(tempPath) Then
        On Error Resume Next
        With Application.Workbooks.Add
            .SaveAs tempPath, XlFileFormat.xlOpenXMLWorkbook
            .Close SaveChanges:=False
        End With
        On Error GoTo 0
    End If
    With Application.Workbooks.Open(tempPath, False, False)
        provider.UrlNamespace = Left$(.FullName, InStrRev(.FullName, "/") - 1)
        .Close SaveChanges:=False
        Kill tempPath
    End With
    On Error GoTo 0
    '
    If repaintOn Then Application.ScreenUpdating = True
    If alertsOn Then Application.DisplayAlerts = True
    If eventsOn Then Application.EnableEvents = True
    '
    provider.isSet = True
End Sub

[guwidoe]

I won't be able to test it until Sunday because I'm not home and don't have my pc with me. I'll let you know if it works once I'm back.

Creating a temporary file might indeed be annoying since it slows everything down significantly... I think I'd rather have it only work on existing files/folders. I can't really think of a use case where I'd need it for non-existent files anyways. I pretty much only use it to convert ThisWorkbook.FullName

[guwidoe]

I now tested your proposed solution and it did pretty well. There were some access denied errors at the Kill tempPath line but it was just a timing issue, it worked fine if I just clicked resume.

Test wise, almost all of the tests passed, the output looked like this:

Test Company SharePoint PASSED
Test2 Company SharePoint PASSED
Test3 Company SharePoint, (file that doesn't exist, but in top lvl directory) PASSED
Test4 Company SharePoint PASSED
Test Personal Business OneDrive PASSED
Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!) PASSED
Test Private OneDrive folder PASSED
Test2 Personal Business OneDrive shared by someone else (nonexistant folder) PASSED

Test3 Private SharePoint shared by someone else (secone level folder mount) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/FirstLevel/SecondLevel/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\https:\d.docs.live.net\5cfc6adc55f2ae2b\FirstLevel\SecondLevel\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\SecondLevel\test.xlsm

Test4 Private SharePoint shared by someone else (second level folder mount with tricky name) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/Test/Test/Test/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\test.xlsm

It passed the non-existent folder Test, which my function failed, but something went wrong on the last two tests. I must say though, that it ran extremely slow, and the saving file constantly showing up is very distracting. Also, how slow it runs ultimately depends not only on your PC but also on your internet connection, since excel has to upload a file.

To me it currently doesn't seem practical like that, I'd much rather continue to use my solution.

I do find the idea very interesting though, do you think you might find a way to solve it without the file-saving step?

[cristianbuse]

Hi @guwidoe

Do you think you can test the below?

Option Explicit

Private Type OneDriveProvider
    urlNamespace As String
    mountPoint As String
End Type
Private Type OneDriveProviders
    arr() As OneDriveProvider
    pCount As Long
    isSet As Boolean
End Type

Public Function GetOneDriveLocalPath(ByVal odWebPath As String) As String
    If InStr(1, odWebPath, "https://", vbTextCompare) = 0 Then Exit Function
    '
    Static providers As OneDriveProviders
    Static isSet As Boolean
    Dim i As Long
    '
    If LenB(odWebPath) = 0 Then Exit Function
    If Not providers.isSet Then
        providers = GetProviders()
        providers.isSet = True
    End If
    For i = 1 To providers.pCount
        With providers.arr(i)
            If StrComp(Left$(odWebPath, Len(.urlNamespace)), .urlNamespace, vbTextCompare) = 0 Then
                GetOneDriveLocalPath = BuildPath(.mountPoint, Replace(odWebPath, .urlNamespace, vbNullString))
                Exit Function
            End If
        End With
    Next i
End Function

Private Function GetProviders() As OneDriveProviders
    Const HKEY_CURRENT_USER = &H80000001
    Const regPath As String = "Software\SyncEngines\Providers\OneDrive\"
    Dim oReg As Object
    Dim subKeys() As Variant
    Dim subKey As Variant

    Dim i As Long
    '
    On Error GoTo CleanExit
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    oReg.EnumKey HKEY_CURRENT_USER, regPath, subKeys
    '
    With GetProviders
        .pCount = UBound(subKeys) - LBound(subKeys) + 1
        ReDim .arr(1 To .pCount)
        i = 1
        For Each subKey In subKeys
            Dim fullKey As String: fullKey = regPath & subKey
            With .arr(i)
                oReg.GetStringValue HKEY_CURRENT_USER, fullKey, "UrlNamespace", .urlNamespace
                oReg.GetStringValue HKEY_CURRENT_USER, fullKey, "MountPoint", .mountPoint
                If StrComp(.urlNamespace, "https://d.docs.live.net", vbTextCompare) = 0 Then
                    Dim cID As String: oReg.GetStringValue HKEY_CURRENT_USER, fullKey, "CID", cID
                    .urlNamespace = .urlNamespace & "/" & cID
                Else
                    FixProviderIfNeeded GetProviders.arr(i)
                End If
            End With
            i = i + 1
        Next subKey
    End With
CleanExit:
End Function

Private Sub FixProviderIfNeeded(ByRef provider As OneDriveProvider)
    Dim fLocal As String
    Dim fWeb As String
    Dim arrParts() As String
    Dim lastPart As String
    Dim tempPath As Variant
    '
    With provider
        If Right$(.mountPoint, 1) = "\" Then
            .mountPoint = Left$(.mountPoint, Len(.mountPoint) - 1)
        End If
        If Right$(.urlNamespace, 1) = "/" Then
            .urlNamespace = Left$(.urlNamespace, Len(.urlNamespace) - 1)
        End If
        '
        fLocal = Right$(.mountPoint, Len(.mountPoint) - InStrRev(.mountPoint, "\"))
        If InStr(1, fLocal, " - ") = 0 Then Exit Sub
        '
        arrParts = Split(fLocal, " - ")
        If arrParts(0) = "OneDrive" Then Exit Sub
        '
        fWeb = Right$(.urlNamespace, Len(.urlNamespace) - InStrRev(.urlNamespace, "/"))
        lastPart = arrParts(UBound(arrParts))
        If fWeb Like "* " & lastPart Then Exit Sub
        '
        For Each tempPath In Array(.urlNamespace & "/" & lastPart _
                                 , .urlNamespace & "/Documents/" & lastPart)
            If IsValidSharepointPath(tempPath) Then
                .urlNamespace = tempPath
                Exit Sub
            End If
        Next tempPath
    End With
End Sub

Public Function IsValidSharepointPath(ByVal path As String) As Boolean
    Dim defPath As String
    With Application.FileDialog(msoFileDialogOpen)
        defPath = .InitialFileName
        .InitialFileName = Environ$("LOCALAPPDATA")
        If Right$(path, 1) <> "/" Then path = path & "/"
        .InitialFileName = path
        IsValidSharepointPath = (InStr(1, .InitialFileName, "https://", vbTextCompare) > 0)
        .InitialFileName = defPath
    End With
End Function

Thanks!

[guwidoe]

Ok, I have no idea what kind of dark magic you are doing here but these are my results.

If I started Excel with an active Internet connection, the first time I call GetLocalPath it takes a bit, maybe like 2-3 seconds, and then subsequent executions of the function are instant and the tests pass just like last time until I restart the application.

Test Company SharePoint PASSED
Test2 Company SharePoint PASSED
Test3 Company SharePoint, (file that doesn't exist, but in top lvl directory) PASSED
Test4 Company SharePoint PASSED
Test Personal Business OneDrive PASSED
Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!) PASSED
Test Private OneDrive folder PASSED
Test2 Personal Business OneDrive shared by someone else (nonexistant folder) PASSED

Test3 Private SharePoint shared by someone else (secone level folder mount) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/FirstLevel/SecondLevel/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\FirstLevel\SecondLevel\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\SecondLevel\test.xlsm

Test4 Private SharePoint shared by someone else (second level folder mount with tricky name) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/Test/Test/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\Test\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\test.xlsm

Now if I start the application without an active internet connection and then run my test sub without internet connection, I get these results:

Test Company SharePoint ERROR:
URL path: https://abconline.sharepoint.com/sites/ACEA/Freigegebene Dokumente/General/2021/04_Working/- Archiv -/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\ABC\ACEA - General\General\2021\04_Working\- Archiv -\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\ABC\ACEA - General\2021\04_Working\- Archiv -\test.xlsm

Test2 Company SharePoint PASSED
Test3 Company SharePoint, (file that doesn't exist, but in top lvl directory) PASSED
Test4 Company SharePoint PASSED
Test Personal Business OneDrive PASSED

Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!) ERROR:
URL path: https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Beispiel import.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Guido\Beispiel import.xlsm
act path: C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Beispiel import.xlsm

Test Private OneDrive folder PASSED

Test2 Personal Business OneDrive shared by someone else (nonexistant folder) ERROR:
URL path: https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Test/
Func ret: C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Guido\Test\
act path: C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Test\

Test3 Private SharePoint shared by someone else (secone level folder mount) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/FirstLevel/SecondLevel/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\FirstLevel\SecondLevel\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\SecondLevel\test.xlsm

Test4 Private SharePoint shared by someone else (second level folder mount with tricky name) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/Test/Test/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\Test\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\test.xlsm

It seems, that here, all the tests failed where the synchronized folder is not at the bottom of the server folder hierarchy.

[cristianbuse]

@guwidoe Thanks for the above! It is really usefull.

It takes longer first time as the providers array is built. Subsequent use is fast as the array is reused (static) at least until state is lost or the array is forcefully rebuilt.

The InitialFileName member of the file dialog seems to be capable of checking if a sharepoint folder is valid but only if internet is on, of course. This could prove to be useful.

I've been playing around with the FileSyncLibrary (COM) but unfortunately it led me nowhere as most of it's functionality is not even compatible with VBA. This would have been awesome to be able to use.

You correctly identified that the issue lies with synchronized folders that are not at the bottom of the server folder hierarchy. Same with all my tests. Really annoying.

Will try a few more things in the next few days.

Again, many thanks!

[cristianbuse]

Hi @guwidoe ,

It would be great if you could test the below:

Option Explicit

Private Type OneDriveProvider
    urlNamespace As String
    mountPoint As String
    actualFolder As String
    isSet As Boolean
    isBusiness As Boolean
End Type
Private Type OneDriveProviders
    arr() As OneDriveProvider
    pCount As Long
    isSet As Boolean
End Type

Public Function GetOneDriveLocalPath(ByVal odWebPath As String) As String
    If InStr(1, odWebPath, "https://", vbTextCompare) = 0 Then Exit Function
    '
    Static providers As OneDriveProviders
    Static isSet As Boolean
    Dim i As Long
    Dim rPart As String
    Dim tempPart As String
    Dim p As Long
    Dim tempActual As String
    Dim multiOccurence As Boolean
    '
    If LenB(odWebPath) = 0 Then Exit Function
    If Not providers.isSet Then
        providers = GetRegistryProviders()
        FixBusinessProviders providers
        providers.isSet = True
    End If
    For i = 1 To providers.pCount
        With providers.arr(i)
            If StrComp(Left$(odWebPath, Len(.urlNamespace)), .urlNamespace, vbTextCompare) = 0 Then
                rPart = Replace(odWebPath, .urlNamespace, vbNullString)
                If Not .isSet Then
                    tempActual = "/" & .actualFolder & "/"
                    p = InStr(1, rPart, tempActual, vbTextCompare)
                    If p = 0 Then Exit Function
                    '
                    multiOccurence = (InStr(p + 1, rPart, tempActual, vbTextCompare) > 0)
                    tempPart = Mid$(rPart, p + IIf(.isBusiness, Len(tempActual), 0))
                    '
                    If multiOccurence Then
                        Do Until LenB(Dir(BuildPath(.mountPoint, tempPart), vbDirectory)) > 0
                            p = InStr(IIf(.isBusiness, 1, p + 1), rPart, tempActual, vbTextCompare)
                            If p = 0 Then Exit Do
                            tempPart = Mid$(rPart, p + IIf(.isBusiness, Len(tempActual), 0))
                        Loop
                    End If
                    rPart = tempPart
                End If
                GetOneDriveLocalPath = BuildPath(.mountPoint, rPart)
                Exit Function
            End If
        End With
    Next i
End Function

Private Function GetRegistryProviders() As OneDriveProviders
    Const HKCU = &H80000001 'HKEY_CURRENT_USER
    Const regPath As String = "Software\SyncEngines\Providers\OneDrive\"
    Dim oReg As Object
    Dim subKeys() As Variant
    Dim subKey As Variant

    Dim i As Long
    '
    On Error GoTo CleanExit
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    oReg.EnumKey HKCU, regPath, subKeys
    '
    With GetRegistryProviders
        .pCount = UBound(subKeys) - LBound(subKeys) + 1
        ReDim .arr(1 To .pCount)
        i = 1
        For Each subKey In subKeys
            ReadRegistryProvider oReg, regPath & subKey, .arr(i)
            i = i + 1
        Next subKey
    End With
CleanExit:
End Function

Private Function ReadRegistryProvider(ByVal oReg As Object _
                                    , ByVal regKey As String _
                                    , ByRef provider As OneDriveProvider)
    Const HKCU = &H80000001
    Dim cid As String
    Dim aFolder As String
    '
    With provider
        oReg.GetStringValue HKCU, regKey, "UrlNamespace", .urlNamespace
        oReg.GetStringValue HKCU, regKey, "MountPoint", .mountPoint
        '
        .isBusiness = Not (.urlNamespace = "https://d.docs.live.net")
        If .isBusiness Then
            If Right$(.urlNamespace, 1) = "/" Then
                .urlNamespace = Left$(.urlNamespace, Len(.urlNamespace) - 1)
            End If
        Else
            oReg.GetStringValue HKCU, regKey, "CID", cid
            oReg.GetStringValue HKCU, regKey, "RelativePath", .actualFolder
            '
            .urlNamespace = .urlNamespace & "/" & cid
            .isSet = (LenB(.actualFolder) = 0)
        End If
    End With
End Function

Private Sub FixBusinessProviders(ByRef providers As OneDriveProviders)
    Dim settingsPath As String
    Dim folderPath As Variant
    Dim folderName As String
    Dim iniName As String
    '
    settingsPath = Environ$("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\"
    For Each folderPath In GetFolders(settingsPath)
        folderName = Right$(folderPath, Len(folderPath) - Len(settingsPath))
        If folderName Like "Business*" Then
            iniName = Dir(BuildPath(folderPath, "????????-????-????-????-????????????.ini"))
            If LenB(iniName) > 0 Then
                FixFromSettingsFile BuildPath(folderPath, iniName), providers
            End If
        End If
    Next folderPath
End Sub

Private Sub FixFromSettingsFile(ByVal filePath As String _
                              , ByRef providers As OneDriveProviders)
    Dim fileNumber As Long
    Dim lineText As String
    Dim arrParts() As String
    Dim tempMount As String
    Dim tempURL As String
    Dim i As Long
    '
    On Error Resume Next
    fileNumber = FreeFile
    Open filePath For Input Access Read As #fileNumber
    Do While Not EOF(fileNumber)
        Line Input #fileNumber, lineText
        arrParts = Split(lineText, " ")
        Select Case Left$(lineText, InStr(1, lineText, " ") - 1)
        Case "libraryScope"
            arrParts = Split(lineText, """")
            tempMount = arrParts(9)
            If LenB(tempMount) > 0 Then
                tempURL = arrParts(5)
                Do
                    i = GetProviderIndexByURL(providers, tempURL)
                    If i > 0 Then providers.arr(i).isSet = True
                Loop Until i = 0
            End If
        Case "libraryFolder"
            arrParts = Split(lineText, """")
            tempMount = arrParts(1)
            providers.arr(GetProviderIndexByPath(providers, tempMount)).actualFolder = arrParts(3)
        Case "AddedScope"
            arrParts = Split(lineText, """")
            tempURL = arrParts(1)
            With providers.arr(GetProviderIndexByURL(providers, tempURL))
                .urlNamespace = .urlNamespace & "/" & arrParts(5)
                .isSet = True
            End With
        Case Else
            Exit Do
        End Select
    Loop
    Close #fileNumber
    On Error GoTo 0
End Sub

Private Function GetProviderIndexByURL(ByRef providers As OneDriveProviders _
                                     , ByVal partURL As String) As Long
    Dim i As Long
    For i = 1 To providers.pCount
        With providers.arr(i)
            If .isBusiness And Not .isSet Then
                If StrComp(Left$(.urlNamespace, Len(partURL)), partURL, vbTextCompare) = 0 Then
                    GetProviderIndexByURL = i
                    Exit Function
                End If
            End If
        End With
    Next i
End Function

Private Function GetProviderIndexByPath(ByRef providers As OneDriveProviders _
                                      , ByVal mountPath As String) As Long
    Dim i As Long
    For i = 1 To providers.pCount
        With providers.arr(i)
            If .isBusiness And Not .isSet Then
                If StrComp(.mountPoint, mountPath, vbTextCompare) = 0 Then
                    GetProviderIndexByPath = i
                    Exit Function
                End If
            End If
        End With
    Next i
End Function

Thanks!

[guwidoe]

Hello @cristianbuse I just ran my tests, only one test failed and it ran pretty fast!

Test Company SharePoint PASSED
Test2 Company SharePoint PASSED
Test3 Company SharePoint, (file that doesn't exist, but in top lvl directory) PASSED
Test4 Company SharePoint PASSED
Test Personal Business OneDrive PASSED
Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!) PASSED
Test Private OneDrive folder PASSED
Test2 Personal Business OneDrive shared by someone else (nonexistant folder) PASSED
Test3 Private SharePoint shared by someone else (secone level folder mount) PASSED

Test4 Private SharePoint shared by someone else (second level folder mount with tricky name) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/Test/Test/Test/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\test.xlsm

[cristianbuse]

@guwidoe

Missed a detail in the Do Until loop. Just updated the previous comment with newer code. Can you please test again?

The last test might still fail. That's because the Dir function is only used when the correct mount folder appears multiple times in the URL (e.g. we know the path should be C:\Users\Witt-DörringGuidoABC\...\test\ but we have no idea which one as we have test 3 times).

Thanks!

[guwidoe]

@cristianbuse

Sorry for the late reply, I wasn't home and had no access to my PC. I now ran the tests again but the last one still fails, the results are the same as in my prior comment.

I have no time at the moment to read and understand all your code but if you use the Dir function that means in some special cases we do have to require the folder to exist right?

It seems like the feature of working on folders that don't exist is just fundamentally impossible as the function must check the actual file structure to determine at what level the server path is mounted.

Also, I added another particularly difficult test case, that even my function fails, even if the file does exist: I synchronized another folder called Test from a different Microsoft Account, now I have two Test folders synchronized, so one of them gets automatically renamed to Test (1). This is what the test code looks like:

TestGetLocalPath "Test4 Private SharePoint shared by someone else (third level folder mount with particularly tricky name)", _
    "https://d.docs.live.net/3dea8a9886f05935/Test/Test/Test/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1)\Test\test.xlsm"

Results with your solution:

Test Company SharePoint PASSED
Test2 Company SharePoint PASSED
Test3 Company SharePoint, (file that doesn't exist, but in top lvl directory) PASSED
Test4 Company SharePoint PASSED
Test Personal Business OneDrive PASSED
Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!) PASSED
Test Private OneDrive folder PASSED
Test2 Personal Business OneDrive shared by someone else (nonexistent folder) PASSED
Test3 Private SharePoint shared by someone else (secone level folder mount) PASSED

Test4 Private SharePoint shared by someone else (second level folder mount with tricky name) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/Test/Test/Test/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\test.xlsm

Test4 Private SharePoint shared by someone else (third level folder mount with particularly tricky name) ERROR:
URL path: https://d.docs.live.net/3dea8a9886f05935/Test/Test/Test/Test/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1)\Test\test.xlsm

If you have other ideas for interesting or tricky test cases involving SharePoint or anything you don't have access to, let me know. Though I'd also understand if you just don't care about these rare and constructed edge cases...

[cristianbuse]

Hi @guwidoe ,

Actually I am very interested in the edge cases and very grateful that you are so helpful.

Would you be able to check if there is a RelativePath subkey for the two failed tests, inside the corresponding registry providers? If yes, would you please share the values?

Thanks!

[guwidoe]

That's good to know :)

Here is my registry for the folders in question:

Another interesting thing I just noticed is, that in case of OneDrive for Business, there is no RelativePath Key, but in the cases where the synchronized folder is not at the bottom of the server folder hierarchy, there exists another key called IsFolderScope with value 1: Otherwise this key just doesn't exist.

[guwidoe]

I just added another test, that is by far the hardest one so far in my opinion:

TestGetLocalPath "Test6 Private SharePoint shared by someone else (fourth level folder mount with extremely tricky name)", _
    "https://d.docs.live.net/3dea8a9886f05935/Test (1)/SecondLevel/Test (1)/FourthLevel/Test (1)/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\FourthLevel\Test (1)\Test\test.xlsm"

I have no idea how any solution could possibly pass both of the last two tests, it seems completely impossible.

EDIT: I think I just came up with a solution in my head, it only works for existing files but it should theoretically be possible. I'll post it here as soon as I translated it into code...

[guwidoe]

I just added two more test cases that might give some more hints as to how we can solve it for the general case:

TestGetLocalPath "Test7 Private SharePoint shared by someone else (third level folder mount with extremely tricky name)", _
    "https://d.docs.live.net/3dea8a9886f05935/Test (2)/SecondLevel/Test (1)/FourthLevel/Test (1)/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1) (1)\FourthLevel\Test (1)\Test\test.xlsm"

TestGetLocalPath "Test8 Private SharePoint shared by someone else (second level folder mount with tricky name)", _
    "https://d.docs.live.net/733ae81c3aefa499/Test/Test/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Test (2)\Test\test.xlsm"

If you synchronize a folder with the actual name Folder (1) on the server, but a Folder (1) already exists in your local OneDrive directory, it will be mounted as Folder (1) (1).

If you synchronize a folder called Folder but Folder and Folder (1) already exist, it will be mounted as Folder (2).

Edit: Also the CID key sometimes takes weird values, for instance: when the path looks like this: https://d.docs.live.net/733ae81c3aefa499/Test/Test/Test/test.xlsm

I wonder if converting it like this is sufficient:

If InStr(1, strCid, "!") Then: _
    strCid = LCase(left(strCid, InStr(1, strCid, "!") - 1))

[guwidoe]

Hello @cristianbuse

I just found where the information we need for those convoluted paths is stored. In the settings file for the personal OneDrive account, there is a file called GroupFolders.ini containing all of the interesting information!

For me the contents look like this:

[GroupFolderUri]
F1189D8C9189D493!3684_BaseUri = https://db3pap003.storage.live.com/Items/5CFC6ADC55F2AE2B!106
F1189D8C9189D493!3684_Path = Test/Test
F1189D8C9189D493!3686_BaseUri = https://db3pap003.storage.live.com/Items/5CFC6ADC55F2AE2B!110
F1189D8C9189D493!3686_Path = FirstLevel/SecondLevel
F1189D8C9189D493!3690_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!108
F1189D8C9189D493!3690_Path = Test/Test/Test
F1189D8C9189D493!3692_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!118
F1189D8C9189D493!3692_Path = Test (1)/SecondLevel/Test (1)/FourthLevel
F1189D8C9189D493!3693_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!124
F1189D8C9189D493!3693_Path = Test (2)/SecondLevel/Test (1)
F1189D8C9189D493!3694_BaseUri = https://db5pap001.storage.live.com/Items/733AE81C3AEFA499!106
F1189D8C9189D493!3694_Path = Test/Test
F1189D8C9189D493!3698_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!134
F1189D8C9189D493!3698_Path = Test (3)/SecondLevel/Test (1)/FourthLevel/Test (1)
F1189D8C9189D493!3699_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!141
F1189D8C9189D493!3699_Path = Test (4)/SecondLevel/Test (1)/FourthLevel/Test (1)

The numbers at the end of these Uri's are exactly the weird CID's we can also see in the registry. This makes it possible to get the information about the server folder structure on the local machine without accessing the internet.

[cristianbuse]

Hi @guwidoe ,

This is excellent. I can see the file in my folder as well.

I am really annoyed because 2 days ago I indexed all the files in the settings folder and used windows search to search for the specific folder name (e.g. Test) inside file contents. Window Search did not find anything and so I did not open each file to search manually. What a useless tool. I can see the name I searched for in the GroupFolders.ini when I open it but search does not find it.

Indeed this find removes the ambiguity and the guessing. Well done!

Won't have time today but will definitely write a new function tomorrow to incorporate your find.

Thanks!

[cristianbuse]

Hello @guwidoe ,

Below is the updated code. For Personal accounts it should now be 100% accurate based on your discovery yesterday. However, there is still some guessing involved for business accounts that are not mounted from the bottom of the hierarchy especially when the root folder appears multiple times in the URL. For now, the below passes all my tests.

Option Explicit

Private Type OneDriveProvider
    cID As String
    urlNamespace As String
    mountPoint As String
    actualFolder As String
    isSet As Boolean
    isBusiness As Boolean
End Type
Private Type OneDriveProviders
    arr() As OneDriveProvider
    pCount As Long
    isSet As Boolean
End Type
Private Enum ProviderFindType
    tCID
    tMount
    tURL
End Enum

'*******************************************************************************
'Returns the local path for a OneDrive web path
'Returns null string if the path provided is not a valid OneDrive web path
'*******************************************************************************
Public Function GetOneDriveLocalPath(ByVal odWebPath As String) As String
    If InStr(1, odWebPath, "https://", vbTextCompare) <> 1 Then Exit Function
    '
    Static providers As OneDriveProviders
    Dim i As Long
    Dim tempURL As String
    '
    If Not providers.isSet Then providers = GetOneDriveProviders()
    '
    For i = 1 To providers.pCount
        With providers.arr(i)
            tempURL = Left$(odWebPath, Len(.urlNamespace))
            If StrComp(tempURL, .urlNamespace, vbTextCompare) = 0 Then Exit For
        End With
    Next i
    If i > providers.pCount Then Exit Function
    '
    Dim rPart As String
    Dim tempPart As String
    Dim p As Long
    Dim tempActual As String
    Dim multiOccurence As Boolean
    '
    With providers.arr(i)
        rPart = Replace(odWebPath, .urlNamespace, vbNullString)
        If Not .isSet Then
            tempActual = "/" & .actualFolder & "/"
            p = InStr(1, rPart, tempActual, vbTextCompare)
            If p = 0 Then Exit Function
            '
            multiOccurence = (InStr(p + 1, rPart, tempActual, vbTextCompare) > 0)
            tempPart = Mid$(rPart, p + Len(tempActual) - 1)
            '
            If multiOccurence Then
                Do Until LenB(Dir(BuildPath(.mountPoint, tempPart), vbDirectory)) > 0
                    p = InStr(p + 1, rPart, tempActual, vbTextCompare)
                    If p = 0 Then Exit Do
                    tempPart = Mid$(rPart, p + Len(tempActual) - 1)
                Loop
            End If
            rPart = tempPart
        End If
        GetOneDriveLocalPath = BuildPath(.mountPoint, rPart)
    End With
End Function

'*******************************************************************************
'Returns all the OD providers using Win registry and OD settings files
'https://docs.microsoft.com/en-us/windows/win32/wmisdk/obtaining-registry-data
'*******************************************************************************
Private Function GetOneDriveProviders() As OneDriveProviders
    Const HKCU = &H80000001 'HKEY_CURRENT_USER
    Const regPath As String = "Software\SyncEngines\Providers\OneDrive\"
    Const computerName As String = "."
    Dim oReg As Object
    Dim subKeys() As Variant
    Dim subKey As Variant
    Dim i As Long
    '
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
        & computerName & "\root\default:StdRegProv")
    oReg.EnumKey HKCU, regPath, subKeys
    '
    With GetOneDriveProviders
        On Error Resume Next
        .pCount = UBound(subKeys) - LBound(subKeys) + 1
        On Error GoTo 0
        If .pCount = 0 Then Exit Function
        '
        ReDim .arr(1 To .pCount)
        i = 1
        For Each subKey In subKeys
            ReadRegistryProvider oReg, regPath & subKey, .arr(i)
            i = i + 1
        Next subKey
        FixProvidersFromSettings .arr
        .isSet = True
    End With
End Function

'*******************************************************************************
'Utility for 'GetOneDriveProviders'
'*******************************************************************************
Private Function ReadRegistryProvider(ByVal oReg As Object _
                                    , ByVal regKey As String _
                                    , ByRef provider As OneDriveProvider)
    Const HKCU = &H80000001
    Dim cID As String
    Dim aFolder As String
    Dim relPath As String
    '
    With provider
        oReg.GetStringValue HKCU, regKey, "UrlNamespace", .urlNamespace
        oReg.GetStringValue HKCU, regKey, "MountPoint", .mountPoint
        oReg.GetStringValue HKCU, regKey, "CID", cID
        .cID = FixCID(cID)
        .isBusiness = Not (.urlNamespace = "https://d.docs.live.net")
        If .isBusiness Then
            If Right$(.urlNamespace, 1) = "/" Then
                .urlNamespace = Left$(.urlNamespace, Len(.urlNamespace) - 1)
            End If
        Else
            oReg.GetStringValue HKCU, regKey, "RelativePath", relPath
            .urlNamespace = .urlNamespace & "/" & .cID
            If LenB(relPath) = 0 Then
                .isSet = True
            Else
                .mountPoint = BuildPath(.mountPoint, relPath)
            End If
        End If
    End With
End Function
Private Function FixCID(ByVal cID As String) As String
    Dim i As Long: i = InStr(1, cID, "!")
    If i = 0 Then FixCID = cID Else FixCID = Left$(cID, i - 1)
End Function

'*******************************************************************************
'Utility for 'GetOneDriveProviders'
'*******************************************************************************
Private Sub FixProvidersFromSettings(ByRef providers() As OneDriveProvider)
    Const businessIniMask As String = "????????-????-????-????-????????????.ini"
    Const settingsRelPath As String = "Microsoft\OneDrive\settings\"
    Dim settingsPath As String
    Dim folderPath As Variant
    Dim folderName As String
    Dim iniName As String
    Dim iniPath As String
    '
    settingsPath = BuildPath(Environ$("LOCALAPPDATA"), settingsRelPath)
    For Each folderPath In GetFolders(settingsPath)
        folderName = Right$(folderPath, Len(folderPath) - Len(settingsPath))
        If folderName Like "Business*" Then
            iniName = Dir(BuildPath(folderPath, businessIniMask))
            If LenB(iniName) > 0 Then
                iniPath = BuildPath(folderPath, iniName)
                FixBusinessProviders iniPath, providers
            End If
        ElseIf folderName = "Personal" Then
            iniPath = BuildPath(settingsPath, "Personal\GroupFolders.ini")
            If IsFile(iniPath) Then
                FixPersonalProviders iniPath, providers
            End If
        End If
    Next folderPath
End Sub

'*******************************************************************************
'Utility for 'FixProvidersFromSettings'
'*******************************************************************************
Private Sub FixBusinessProviders(ByVal filePath As String _
                               , ByRef providers() As OneDriveProvider)
    Dim fileNumber As Long: fileNumber = FreeFile
    Dim lineText As String
    Dim arrParts() As String
    Dim tempMount As String
    Dim tempURL As String
    Dim i As Long
    '
    Open filePath For Input Access Read As #fileNumber
    Do While Not EOF(fileNumber)
        Line Input #fileNumber, lineText
        '
        Select Case Left$(lineText, InStr(1, lineText, " ") - 1)
        Case "libraryScope"
            arrParts = Split(lineText, """")
            If UBound(arrParts) >= 9 Then
                tempMount = arrParts(9)
                If LenB(tempMount) > 0 Then
                    tempURL = arrParts(5)
                    Do
                        i = FindProvider(providers, tURL, tempURL)
                        If i > 0 Then providers(i).isSet = True
                    Loop Until i = 0
                End If
            End If
        Case "libraryFolder"
            arrParts = Split(lineText, """")
            If UBound(arrParts) >= 3 Then
                tempMount = arrParts(1)
                i = FindProvider(providers, tMount, tempMount)
                If i > 0 Then providers(i).actualFolder = arrParts(3)
            End If
        Case "AddedScope"
            arrParts = Split(lineText, """")
            If UBound(arrParts) >= 3 Then
                tempURL = arrParts(1)
                i = FindProvider(providers, tURL, tempURL)
                If i > 0 Then
                    With providers(i)
                        .urlNamespace = .urlNamespace & "/" & arrParts(5)
                        .isSet = True
                    End With
                End If
            End If
        Case Else
            Exit Do
        End Select
    Loop
    Close #fileNumber
End Sub

'*******************************************************************************
'Utility for finding a provider that is not set
'*******************************************************************************
Private Function FindProvider(ByRef providers() As OneDriveProvider _
                            , ByVal findType As ProviderFindType _
                            , ByVal searchValue As String) As Long
    Dim i As Long
    Dim temp As String
    For i = LBound(providers) To UBound(providers)
        With providers(i)
            If Not .isSet Then
                Select Case findType
                    Case tCID:   temp = .cID
                    Case tMount: temp = .mountPoint
                    Case tURL:   temp = Left$(.urlNamespace, Len(searchValue))
                End Select
                If StrComp(temp, searchValue, vbTextCompare) = 0 Then
                    FindProvider = i
                    Exit Function
                End If
            End If
        End With
    Next i
End Function

'*******************************************************************************
'Utility for 'FixProvidersFromSettings'
'*******************************************************************************
Private Sub FixPersonalProviders(ByVal filePath As String _
                               , ByRef providers() As OneDriveProvider)
    Dim fileNumber As Long: fileNumber = FreeFile
    Dim lineText As String
    Dim i As Long
    Dim cID As String
    Dim relPath As String
    '
    Open filePath For Input Access Read As #fileNumber
    Do While Not EOF(fileNumber)
        Line Input #fileNumber, lineText
        '
        i = InStr(1, lineText, "_")
        If i > 0 Then
            i = i + 1
            Select Case Mid$(lineText, i, InStr(i, lineText, " ") - i)
            Case "BaseUri"
                cID = FixCID(Mid$(lineText, InStrRev(lineText, "/") + 1))
            Case "Path"
                relPath = Mid$(lineText, InStr(lineText, " = ") + 3)
                i = FindProvider(providers, tCID, cID)
                If i > 0 Then
                    With providers(i)
                        .urlNamespace = .urlNamespace & "/" & relPath
                        .isSet = True
                    End With
                End If
            End Select
        End If
    Loop
    Close #fileNumber
End Sub

[guwidoe]

Hello @cristianbuse

Unfortunately, there are still some problems. :( For a little speculation why please read the end of my post! I updated my tests multiple times, so I'll post them all again here for clarity.

TestGetLocalPath "Test Company SharePoint", _
    "https://abconline.sharepoint.com/sites/ACEA/Freigegebene Dokumente/General/2021/04_Working/- Archiv -/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\ABC\ACEA - General\2021\04_Working\- Archiv -\test.xlsm"

TestGetLocalPath "Test2 Company SharePoint", _
    "https://abconline.sharepoint.com/sites/AI/Freigegebene Dokumente/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\ABC\AI - Dokumente\Test\test.xlsm"

TestGetLocalPath "Test3 Company SharePoint, (file that doesn't exist, but in top lvl directory)", _
    "https://abconline.sharepoint.com/sites/workspaces/ntbas/Shared Documents/Test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\ABC\NTB After Sales - Documents\Test.xlsm"

TestGetLocalPath "Test4 Company SharePoint", _
    "https://abconline.sharepoint.com/sites/workspaces/NTB/Shared Documents/100_Business Development/", _
    "C:\Users\Witt-DörringGuidoABC\ABC\NTB - Documents\100_Business Development\"

 TestGetLocalPath "Test Personal Business OneDrive", _
    "https://abconline-my.sharepoint.com/personal/gwitt-doerring_abc_at/Documents/-Test-/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive - ABC\-Test-\test.xlsm"

TestGetLocalPath "Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!)", _
    "https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Beispiel import.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Beispiel import.xlsm"

TestGetLocalPath "Test Private OneDrive folder", _
    "https://d.docs.live.net/f1189d8c9189d493/Testfolder_toplvl/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Testfolder_toplvl\test.xlsm"

TestGetLocalPath "Test2 Personal Business OneDrive shared by someone else (nonexistant folder)", _
    "https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Test/", _
    "C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Test\"

TestGetLocalPath "Test3 Private SharePoint shared by someone else (second level folder mount)", _
    "https://d.docs.live.net/5cfc6adc55f2ae2b/FirstLevel/SecondLevel/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\SecondLevel\test.xlsm"

TestGetLocalPath "Test4 Private SharePoint shared by someone else (second level folder mount with tricky name)", _
    "https://d.docs.live.net/5cfc6adc55f2ae2b/Test/Test/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\test.xlsm"

TestGetLocalPath "Test5 Private SharePoint shared by someone else (third level folder mount with particularly tricky name)", _
    "https://d.docs.live.net/3dea8a9886f05935/Test/Test/Test/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1)\Test\test.xlsm"

TestGetLocalPath "Test6 Private SharePoint shared by someone else (fourth level folder mount with extremely tricky name)", _
    "https://d.docs.live.net/3dea8a9886f05935/Test (1)/SecondLevel/Test (1)/FourthLevel/Test (1)/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\FourthLevel\Test (1)\Test\test.xlsm"

TestGetLocalPath "Test7 Private SharePoint shared by someone else (third level folder mount with extremely tricky name)", _
    "https://d.docs.live.net/3dea8a9886f05935/Test (2)/SecondLevel/Test (1)/FourthLevel/Test (1)/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1) (1)\FourthLevel\Test (1)\Test\test.xlsm"

TestGetLocalPath "Test8 Private SharePoint shared by someone else (third level folder mount with extremely tricky name)", _
    "https://d.docs.live.net/3dea8a9886f05935/Test (3)/SecondLevel/Test (1)/FourthLevel/Test (1)/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1) (2)\Test\test.xlsm"

TestGetLocalPath "Test9 Private SharePoint shared by someone else (third level folder mount with extremely tricky name)", _
    "https://d.docs.live.net/3dea8a9886f05935/Test (4)/SecondLevel/Test (1)/FourthLevel/Test (1)/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1) (3)\Test\test.xlsm"

TestGetLocalPath "Test10 Private SharePoint shared by someone else (second level folder mount with tricky name)", _
    "https://d.docs.live.net/733ae81c3aefa499/Test/Test/Test/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Test (2)\Test\test.xlsm"

TestGetLocalPath "Test11 Private SharePoint (Business1 folder name because of supposed cunfusion in the registry, but the registry key just got overwritten)", _
    "https://d.docs.live.net/3dea8a9886f05935/Business1/test.xlsm", _
    "C:\Users\Witt-DörringGuidoABC\OneDrive\Business1\test.xlsm"

The current results are as follows.

Test Company SharePoint PASSED
Test2 Company SharePoint PASSED
Test3 Company SharePoint, (file that doesn't exist, but in top lvl directory) PASSED
Test4 Company SharePoint PASSED
Test Personal Business OneDrive PASSED
Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!) PASSED
Test Private OneDrive folder PASSED
Test2 Personal Business OneDrive shared by someone else (nonexistant folder) PASSED

Test3 Private SharePoint shared by someone else (second level folder mount) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/FirstLevel/SecondLevel/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\Test\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\SecondLevel\test.xlsm

Test4 Private SharePoint shared by someone else (second level folder mount with tricky name) ERROR:
URL path: https://d.docs.live.net/5cfc6adc55f2ae2b/Test/Test/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\SecondLevel\Test\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test\Test\test.xlsm

Test5 Private SharePoint shared by someone else (third level folder mount with particularly tricky name) ERROR:
URL path: https://d.docs.live.net/3dea8a9886f05935/Test/Test/Test/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\Business1\https:\d.docs.live.net\3dea8a9886f05935\Test\Test\Test\Test\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1)\Test\test.xlsm

Test6 Private SharePoint shared by someone else (fourth level folder mount with extremely tricky name) ERROR:
URL path: https://d.docs.live.net/3dea8a9886f05935/Test (1)/SecondLevel/Test (1)/FourthLevel/Test (1)/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\FourthLevel\https:\d.docs.live.net\3dea8a9886f05935\Test (1)\SecondLevel\Test (1)\FourthLevel\Test (1)\Test\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\FourthLevel\Test (1)\Test\test.xlsm

Test7 Private SharePoint shared by someone else (third level folder mount with extremely tricky name) ERROR:
URL path: https://d.docs.live.net/3dea8a9886f05935/Test (2)/SecondLevel/Test (1)/FourthLevel/Test (1)/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1)\FourthLevel\Test (1)\Test\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1) (1)\FourthLevel\Test (1)\Test\test.xlsm

Test8 Private SharePoint shared by someone else (third level folder mount with extremely tricky name) ERROR:
URL path: https://d.docs.live.net/3dea8a9886f05935/Test (3)/SecondLevel/Test (1)/FourthLevel/Test (1)/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1) (1)\https:\d.docs.live.net\3dea8a9886f05935\Test (3)\SecondLevel\Test (1)\FourthLevel\Test (1)\Test\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1) (2)\Test\test.xlsm

Test9 Private SharePoint shared by someone else (third level folder mount with extremely tricky name) ERROR:
URL path: https://d.docs.live.net/3dea8a9886f05935/Test (4)/SecondLevel/Test (1)/FourthLevel/Test (1)/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1) (2)\https:\d.docs.live.net\3dea8a9886f05935\Test (4)\SecondLevel\Test (1)\FourthLevel\Test (1)\Test\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1) (3)\Test\test.xlsm

Test10 Private SharePoint shared by someone else (second level folder mount with tricky name) ERROR:
URL path: https://d.docs.live.net/733ae81c3aefa499/Test/Test/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (2)\https:\d.docs.live.net\733ae81c3aefa499\Test\Test\Test\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (2)\Test\test.xlsm

Test11 Private SharePoint (Business1 folder name because of supposed cunfusion in the registry, but the registry key just got overwritten) ERROR:
URL path: https://d.docs.live.net/3dea8a9886f05935/Business1/test.xlsm
Func ret: C:\Users\Witt-DörringGuidoABC\OneDrive\Test (1) (3)\https:\d.docs.live.net\3dea8a9886f05935\Business1\test.xlsm
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Business1\test.xlsm

I'm currently trying to write my own version of the function but as a self contained procedure without external dependencies or private types. In doing so I noticed another inconsistency between the Registry and the GroupFolders.ini file.

My GroupFolders.ini file looks like this:

[GroupFolderUri]
F1189D8C9189D493!3684_BaseUri = https://db3pap003.storage.live.com/Items/5CFC6ADC55F2AE2B!106
F1189D8C9189D493!3684_Path = Test/Test
F1189D8C9189D493!3686_BaseUri = https://db3pap003.storage.live.com/Items/5CFC6ADC55F2AE2B!110
F1189D8C9189D493!3686_Path = FirstLevel/SecondLevel
F1189D8C9189D493!3690_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!108
F1189D8C9189D493!3690_Path = Test/Test/Test
F1189D8C9189D493!3692_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!118
F1189D8C9189D493!3692_Path = Test (1)/SecondLevel/Test (1)/FourthLevel
F1189D8C9189D493!3693_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!124
F1189D8C9189D493!3693_Path = Test (2)/SecondLevel/Test (1)
F1189D8C9189D493!3694_BaseUri = https://db5pap001.storage.live.com/Items/733AE81C3AEFA499!106
F1189D8C9189D493!3694_Path = Test/Test
F1189D8C9189D493!3698_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!134
F1189D8C9189D493!3698_Path = Test (3)/SecondLevel/Test (1)/FourthLevel/Test (1)
F1189D8C9189D493!3699_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!141
F1189D8C9189D493!3699_Path = Test (4)/SecondLevel/Test (1)/FourthLevel/Test (1)
F1189D8C9189D493!3701_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!144
F1189D8C9189D493!3701_Path = Business1

The big problem is, that not all of the cids appearing here actually appear in the registry! For example the second one:

F1189D8C9189D493!3686_BaseUri = https://db3pap003.storage.live.com/Items/5CFC6ADC55F2AE2B!110
F1189D8C9189D493!3686_Path = FirstLevel/SecondLevel

Refers to this folder: https://d.docs.live.net/5cfc6adc55f2ae2b/FirstLevel/SecondLevel/test.xlsm, local: C:\Users\Witt-DörringGuidoABC\OneDrive\SecondLevel\Test\test.xlsm, but in the registry it looks like this:

This cid from the registry is not even unique, for instance, the first entry of the file looks like this:

F1189D8C9189D493!3684_BaseUri = https://db3pap003.storage.live.com/Items/5CFC6ADC55F2AE2B!106
F1189D8C9189D493!3684_Path = Test/Test

And the registry looks like this:

In fact. I can't find the cids 5CFC6ADC55F2AE2B!110 and 5CFC6ADC55F2AE2B!106 at all in the registry!

For other folders, it looks like this should work just fine, for instance, this one:

F1189D8C9189D493!3692_BaseUri = https://db3pap002.storage.live.com/Items/3DEA8A9886F05935!118
F1189D8C9189D493!3692_Path = Test (1)/SecondLevel/Test (1)/FourthLevel

can easily be correlated using the registry:

The only place I found these cid's (5CFC6ADC55F2AE2B!110 and 5CFC6ADC55F2AE2B!106) is in the personal %cid%.dat file:

But I'm not yet sure how to read it correctly and if it even contains all the information we need. All I know is that I never want to work with Microsoft's OneDrive codebase, that must be such an unbelievable mess...

Another question I have for you: In the Business .ini file, you read lines starting with AddedScope, on my computer I don't have such lines, can you maybe send me a screenshot of it, or do you know where they are from?

P.s. By the way I have the same problem with Windows Search, did you find a solution or some third-party software?

[cristianbuse]

@guwidoe

I see. I wasn't expecting to have same CID for multiple providers. I did not see that on mine. It makes sense the tests are failing as I can clearly see that your first 2 failed tests have the root folder the exact way around.

I already looked into the .dat file using OneDriveExplorer (see last release) but it does not look to be useful and moreover the file is so big that it would take some time to parse.

The AddedScope only appears if instead of syncing someone else's folder you add it as a shortcut to your own OneDrive in which case the AddedScope line provides the missing URL part. It's probably another edge case you want to add to your tests. Note that if you already have something synced from a user you can NOT also have a shortcut and viceversa.

The AddedScope line appears after the libraryFolder lines. Example: AddedScope = 7 8ce2047bd475450996fc7d826401935b 3 "https://cbre-my.sharepoint.com/personal/user_name_company_com" 0159e9d0-09a0-4edf-96ba-a3deea363c28 cc3f73ff1a44496e8c567a2018822e92 f967dbcfd9324b4c99d0204d8c297ace c8209219a40f4a2b94da6752ddb67c4f 772ea51fb0b04abca63673b6e32e6a10 "Test/File/Test"

[guwidoe]

@cristianbuse

I now managed to write a function that passes all my tests, I couldn't test the AddedScope case, would you be so kind to test my function on your machine? EDIT: I now added a second Business account to my machine where I was also able to test the AddedScope part of my code. I updated the function accordingly. It now passes all tests I could come up with. I'd still be happy if you could test it too!

Private Function GetLocalPath(ByVal path As String, _
                              Optional ByVal rebuildCache As Boolean = False) _
                              As String
    Const HKEY_CURRENT_USER = &H80000001
    Const computerName As String = "."

    Static WebToLocDict As Object 'Scripting.Dictionary
    If Not WebToLocDict Is Nothing And Not rebuildCache Then GoTo UseDict

    Set WebToLocDict = Nothing
    Set WebToLocDict = CreateObject("Scripting.Dictionary")

    Dim objReg As Object
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
                            computerName & "\root\default:StdRegProv")

    Dim regPath As String
    regPath = "Software\SyncEngines\Providers\OneDrive\"

    Dim subKeys() As Variant
    objReg.EnumKey HKEY_CURRENT_USER, regPath, subKeys

    Dim subKey As Variant
    Dim cid As String
    Dim relPath As String
    Dim webRoot As String
    Dim locRoot As String

    For Each subKey In subKeys
        objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, _
                              "UrlNamespace", webRoot
        objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, "CID", cid

        'InStr(cid, "-") = 0 to check if it's not a business cid
        If cid <> "" And InStr(cid, "-") = 0 Then: _
            webRoot = webRoot & "/" & LCase(cid)
        If right(webRoot, 1) = "/" Then: _
            webRoot = left(webRoot, Len(webRoot) - 1)

        objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, _
                              "MountPoint", locRoot
        objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, _
                              "RelativePath", relPath

        If relPath <> "" Then: locRoot = locRoot & "\" & relPath

        'Adding subKey to the dict is necessary because the constructed webRoot
        'is not necessarily unique.
        WebToLocDict(subKey & "\" & webRoot) = locRoot
    Next

    Dim dirName As String
    Dim odSettPath As String
    Dim odSettFile As String
    Dim fileNumber As Long
    Dim lineText As String
    Dim lineParts() As String
    Dim vWebRoot As Variant
    Dim cidClean As String
    Dim webMountDir As String
    Dim residue As String
    Dim i As Long

    objReg.GetStringValue HKEY_CURRENT_USER, "Volatile Environment", _
                          "LOCALAPPDATA", odSettPath

    regPath = "Software\Microsoft\OneDrive\Accounts\"
    odSettPath = odSettPath & "\Microsoft\OneDrive\settings\"

    dirName = Dir(odSettPath, vbDirectory)
    Do Until dirName = ""
        Select Case True
        Case dirName Like "Business#"
            objReg.GetStringValue HKEY_CURRENT_USER, regPath & dirName, _
                                  "cid", cid
            If cid <> "" Then
                odSettFile = odSettPath & dirName & "\" & cid & ".ini"
                fileNumber = FreeFile
                Open odSettFile For Input Access Read As #fileNumber
                    Do While Not EOF(fileNumber)
                        Line Input #fileNumber, lineText
                        Select Case left$(lineText, InStr(lineText, " = ") - 1)
                        Case "libraryScope"
                            'No change to dict necessary
                        Case "libraryFolder"
                            lineParts = Split(lineText, """")
                            For Each vWebRoot In WebToLocDict.Keys
                                If WebToLocDict(vWebRoot) = lineParts(1) Then
                                    WebToLocDict.Add key:=vWebRoot & "/" & _
                                                          lineParts(3), _
                                                     Item:=WebToLocDict(vWebRoot)
                                    WebToLocDict.Remove vWebRoot
                                    Exit For
                                End If
                            Next vWebRoot
                        Case "AddedScope"
                            lineParts = Split(lineText, """")
                            For Each vWebRoot In WebToLocDict.Keys
                                webRoot = Mid(vWebRoot, InStr(vWebRoot, "\") + 1)
                                If InStr(1, webRoot, lineParts(1), _
                                vbBinaryCompare) = 1 Then
                                    WebToLocDict.Add key:=vWebRoot & "/" & _
                                                          lineParts(5), _
                                                     Item:=WebToLocDict(vWebRoot)
                                    WebToLocDict.Remove vWebRoot
                                    Exit For
                                End If
                            Next vWebRoot
                        Case Else
                            Exit Do
                        End Select
                    Loop
                Close #fileNumber
            End If
        Case dirName = "Personal"
            cid = ""
            odSettFile = odSettPath & dirName & "\GroupFolders.ini"
            fileNumber = FreeFile
            Open odSettFile For Input Access Read As #fileNumber
                Do While Not EOF(fileNumber)
                    Line Input #fileNumber, lineText
                    If InStr(lineText, "aseUri = https://") And cid = "" Then
                        cid = LCase(Mid(lineText, InStrRev(lineText, "/") + 1))
                        cidClean = left(cid, InStr(cid, "!") - 1)
                    ElseIf cid <> "" Then
                        For i = UBound(WebToLocDict.Keys) To 0 Step -1
                            vWebRoot = WebToLocDict.Keys()(i)
                            locRoot = WebToLocDict(vWebRoot)
                            webRoot = Mid(vWebRoot, InStr(vWebRoot, "\") + 1)
                            subKey = left(vWebRoot, InStr(vWebRoot, "\"))
                            If right(webRoot, Len(cid)) = cid Then
                                WebToLocDict.Add _
                                    key:=subKey & _
                                       left(webRoot, InStrRev(webRoot, "/")) & _
                                     left(cid, InStr(1, cid, "!") - 1) & "/" & _
                                    Mid(lineText, InStr(lineText, " = ") + 3), _
                                    Item:=locRoot
                                WebToLocDict.Remove vWebRoot
                                Exit For
                            'This ElseIf is necessary because the cid's from the
                            'registry are unfortunately not necssarily unique
                            ElseIf Mid(webRoot, InStrRev(webRoot, "/") + 1) = _
                            cidClean Then
                                relPath = _
                                    Mid(locRoot, InStrRev(locRoot, "\") + 1)
                                webMountDir = _
                                    Mid(lineText, InStr(lineText, " = ") + 3)
                                webMountDir = _
                                Mid(webMountDir, InStrRev(webMountDir, "/") + 1)
                                residue = Replace(relPath, webMountDir, "", , 1)
                                'The " (#)" are necessary in case two or more
                                'folders with the same name are synchronized.
                                'In OneDrive, a folder contains max 50000 items.
                                If residue = "" Or _
                                residue Like " (#)" Or _
                                residue Like " (##)" Or _
                                residue Like " (###)" Or _
                                residue Like " (####)" Or _
                                residue Like " (#####)" Then
                                    WebToLocDict.Add _
                                        key:=subKey & webRoot & "/" & _
                                             Mid(lineText, _
                                             InStr(lineText, " = ") + 3), _
                                        Item:=locRoot
                                    WebToLocDict.Remove vWebRoot
                                    Exit For
                                End If
                            End If
                        Next i
                        cid = ""
                    End If
                Loop
            Close #fileNumber
        Case Else
        End Select
        dirName = Dir
    Loop

UseDict:
    For Each vWebRoot In WebToLocDict.Keys
        webRoot = Mid(vWebRoot, InStr(vWebRoot, "\") + 1)
        If InStr(1, path, webRoot, vbBinaryCompare) Then
            path = Replace(path, webRoot, WebToLocDict(vWebRoot))
            GetLocalPath = Replace(path, "/", "\")
            Exit Function
        End If
    Next vWebRoot
End Function

The only part which is a little bit dodgy is the following:

                    ElseIf cid <> "" Then
                        For i = UBound(WebToLocDict.Keys) To 0 Step -1
                            vWebRoot = WebToLocDict.Keys()(i)
                            locRoot = WebToLocDict(vWebRoot)
                            webRoot = Mid(vWebRoot, InStr(vWebRoot, "\") + 1)
                            subKey = left(vWebRoot, InStr(vWebRoot, "\"))
                            If right(webRoot, Len(cid)) = cid Then
                                WebToLocDict.Add _
                                    key:=subKey & _
                                       left(webRoot, InStrRev(webRoot, "/")) & _
                                     left(cid, InStr(1, cid, "!") - 1) & "/" & _
                                    Mid(lineText, InStr(lineText, " = ") + 3), _
                                    Item:=locRoot
                                WebToLocDict.Remove vWebRoot
                                Exit For
                            'This ElseIf is necessary because the cid's from the
                            'registry are unfortunately not necssarily unique
                            ElseIf Mid(webRoot, InStrRev(webRoot, "/") + 1) = _
                            cidClean Then
                                relPath = _
                                    Mid(locRoot, InStrRev(locRoot, "\") + 1)
                                webMountDir = _
                                    Mid(lineText, InStr(lineText, " = ") + 3)
                                webMountDir = _
                                Mid(webMountDir, InStrRev(webMountDir, "/") + 1)
                                residue = Replace(relPath, webMountDir, "", , 1)
                                'The " (#)" are necessary in case two or more
                                'folders with the same name are synchronized.
                                'In OneDrive, a folder contains max 50000 items.
                                If residue = "" Or _
                                residue Like " (#)" Or _
                                residue Like " (##)" Or _
                                residue Like " (###)" Or _
                                residue Like " (####)" Or _
                                residue Like " (#####)" Then
                                    WebToLocDict.Add _
                                        key:=subKey & webRoot & "/" & _
                                             Mid(lineText, _
                                             InStr(lineText, " = ") + 3), _
                                        Item:=locRoot
                                    WebToLocDict.Remove vWebRoot
                                    Exit For
                                End If
                            End If
                        Next i
                        cid = ""
                    End If

I don't quite understand how OneDrive works with the registry and why it didn't provide a unique cid for two of my synced folders. By constructing the if statement like I did I managed to overcome this problem, but if OneDrive decides to add more folders without unique cid, and the names of these folders are expertly crafted just to try and fool my function it might still be possible. But whenever I synchronize another folder, I feel like it always assigns a unique cid now, so it should always work now, I think.

[cristianbuse]

Thanks for this! Will only be able to test on Monday. Will get back to you then

[cristianbuse]

Hi @guwidoe ,

Just ran my tests with your newest function and 4 out of 12 tests fail. All 4 are shared folders from other colleagues business OneDrive.

I am swamped today/tomorrow but my hope is that this week I can look into your function logic and see if I can combine with mine and get something that passes both our tests.

Many thanks!

[guwidoe]

Hi @cristianbuse

Thanks for testing, that's good to know! Can you share the UrlPath, CorrectLocalPath and Function return value? You can just anonymize the paths like in my previous posts.

I'd really like to know where my function fails!

Thank you!

[cristianbuse]

@guwidoe

Of course, I was planning to do that but had to go through a call first.

Here are the tests in the same format as yours:

    TestGetLocalPath "Test8 Personal Business OneDrive shared by someone else", _
        "https://cbre-my.sharepoint.com/personal/firstName_lastName_company_com/Documents/Documents/Folder Name/fileName.xlsx", _
        "C:\Users\CBuse\CBRE, Inc\lastName, firstName @ London - Folder Name\fileName.xlsx"

    TestGetLocalPath "Test9 Personal Business OneDrive shared by someone else (non-existent folder)", _
        "https://cbre-my.sharepoint.com/personal/firstName_lastName_company_com/Documents/Documents/Folder Name/test/", _
        "C:\Users\CBuse\CBRE, Inc\lastName, firstName @ London - Folder Name\test\"

    TestGetLocalPath "Test10 Personal Business OneDrive shared by someone else (3 levels mount)", _
        "https://cbre-my.sharepoint.com/personal/firstName2_lastName2_company_com/Documents/Folder Name 2/Folder Name 3/Folder Name 4/fileName2.xlsx", _
        "C:\Users\CBuse\CBRE, Inc\lastName2, firstName2 @ London XX - Folder Name 4\fileName2.xlsx"

    TestGetLocalPath "Test12 Personal Business OneDrive shared by someone else (3 levels mount)", _
        "https://cbre-my.sharepoint.com/personal/firstName3_lastName3_company_com/Documents/Test/File/Test/3.xlsx", _
        "C:\Users\CBuse\CBRE, Inc\lastName3, firstName3 @ London XX - Test\3.xlsx"

First 3 tests are returning nothing (null string) and the 4th one returns:
C:\Users\CBuse\CBRE, Inc\lastName3, firstName3 @ London XX - Test\File\Test\3.xlsx
instead of:
"C:\Users\CBuse\CBRE, Inc\lastName3, firstName3 @ London XX - Test\3.xlsx"

[guwidoe]

Hi @cristianbuse

Thank you very much for your tests, I'm also quite busy at the moment but have managed to look into the issue with my function a little bit.

I have now recreated these tests and some more too. Unfortunately, I'm now convinced that our goal of writing a function solving all cases is impossible with the resources we have discovered so far.

It's funny because for the addedScope it can be solved for all possible syncs and for the Personal OneDrive too, there is just the niche case of SharePoint library folders that are synchronized on the 2nd level or higher where not enough information is stored in the .ini files. This case can still be solved for probably around 99% of real-world cases, but it's easy to construct a path that is unsolvable. Consider the following example:

WebPath: https://companyname.sharepoint.com/sites/TestLib/Freigegebene Dokumente/Test/Test/Test/Test/Test/Test/Test/Test/Test/test.xlsm 
LocPath: C:\Users\Witt-DörringGuidoABC\Company Name\TestLib - Test\Test\Test\test.xlsm

We can assume, that in each of these folders, there is a test.xlsm file. In this case, the library scope line will look something like this:

libraryScope = 1 5404014da42949c3af2bf558970233a6+1 5 "TestLib3rdLvlMount" "Dokumente" 4 "https://companyname.sharepoint.com/sites/TestLib" "dffdfdd4-77f5-445a-9dc0-1f5c6d259395" 9d85bcc70f964867ab531b8a918d89b5 2e351aec44184b348acb2a8fef7da70f 223717ee7bb3432ca991b96d3da29d7f 0 "" 1 00000000-0000-0000-0000-000000000000  - 0 0 00000000-0000-0000-0000-000000000000 

This doesn't help us at all but shows us that there will also be a libraryFolder line, because of the ...9d7f 0 "" 1 0000... part, otherwise, the mount point would be between these quotes. Also, it gives us the UrlNamespace, but not even the full one. This doesn't matter, however, because we can get that from the registry anyways.

The libraryFolder line will help us a little more, it will look something like this:

libraryFolder = 3 1 ffb92bb4f58745299037b4713e012faf+1 1656974198 "C:\Users\Witt-DörringGuidoABC\Company Name\TestLib - Test" 1 "Test" 68da3f5f-721e-4b7d-86cb-904988ac670f 32932572275197086 1017134003 00000000-0000-0000-0000-000000000000 

It gives us the correct mount point, which we don't need either because we already got it from the registry, but more importantly, the name of the server folder which was synchronized, in this case, Test. If the name of this folder only appears once in the given WebPath we can solve it now, this will probably be the case in most real-world scenarios.

In the example I gave, however, we still don't know at what level the server folder structure was mounted. I now checked every single file in the settings directory and couldn't find any more information about this... Maybe the info exists in one of the binary files I can't read.

Only the ClientPolicy_???????????....????????.ini files contain some suspicious lines like

DavUrlTemplate = https://companyname.sharepoint.com/sites/TestLib2/Freigegebene Dokumente/{Path}

but don't define {Path} anywhere, unfortunately.

Do you have any other ideas where we could look?

[cristianbuse]

Hi @guwidoe ,

Unfortunately, I don't. I have also spent a considerable amount of hours/days looking into this and I agree we simply do not have sufficient information. That is precisely why I was trying to work with the COM libraries for OneDrive but with no success.

Will revisit this in the following days as today I am too busy but I don't think I will be able to do more that you already did.

[cristianbuse]

Hi @guwidoe ,

I was away for a few days but I managed to look into this again today. I eventually ended up reading both the personal and business DAT files. Now all my tests are passing and including for non-existing files and folders.

Could you please test again with the below? If this works for you as well, then I will need to refactor it and push to the repository. Thanks in advance!

Option Explicit

Private Type OneDriveProvider
    cid As String
    urlNamespace As String
    mountPoint As String
    actualFolder As String
    isSet As Boolean
    isBusiness As Boolean
End Type
Private Type OneDriveProviders
    arr() As OneDriveProvider
    pCount As Long
    isSet As Boolean
End Type
Private Enum ProviderFindType
    tCID
    tMount
    tURL
End Enum

'*******************************************************************************
'Returns the local path for a OneDrive web path
'Returns null string if the path provided is not a valid OneDrive web path
'*******************************************************************************
Public Function GetOneDriveLocalPath(ByVal odWebPath As String) As String
    If InStr(1, odWebPath, "https://", vbTextCompare) <> 1 Then Exit Function
    '
    Static providers As OneDriveProviders
    Dim i As Long
    Dim tempURL As String
    Dim rPart As String
    '
    If Not providers.isSet Then providers = GetOneDriveProviders()
    '
    For i = 1 To providers.pCount
        With providers.arr(i)
            tempURL = Left$(odWebPath, Len(.urlNamespace))
            If StrComp(tempURL, .urlNamespace, vbTextCompare) = 0 Then Exit For
        End With
    Next i
    If i > providers.pCount Then Exit Function
    '
    With providers.arr(i)
        If Not .isSet Then Exit Function
        rPart = Replace(odWebPath, .urlNamespace, vbNullString)
        GetOneDriveLocalPath = BuildPath(.mountPoint, rPart)
    End With
End Function

'*******************************************************************************
'Returns all the OD providers using Win registry and OD settings files
'https://docs.microsoft.com/en-us/windows/win32/wmisdk/obtaining-registry-data
'*******************************************************************************
Private Function GetOneDriveProviders() As OneDriveProviders
    Const HKCU = &H80000001 'HKEY_CURRENT_USER
    Const regPath As String = "Software\SyncEngines\Providers\OneDrive\"
    Const computerName As String = "."
    Dim oReg As Object
    Dim subKeys() As Variant
    Dim subKey As Variant
    Dim i As Long
    '
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
        & computerName & "\root\default:StdRegProv")
    oReg.EnumKey HKCU, regPath, subKeys
    '
    With GetOneDriveProviders
        On Error Resume Next
        .pCount = UBound(subKeys) - LBound(subKeys) + 1
        On Error GoTo 0
        If .pCount = 0 Then Exit Function
        '
        ReDim .arr(1 To .pCount)
        i = 1
        For Each subKey In subKeys
            ReadRegistryProvider oReg, regPath & subKey, .arr(i)
            i = i + 1
        Next subKey
        FixProvidersFromSettings .arr
        .isSet = True
    End With
End Function

'*******************************************************************************
'Utility for 'GetOneDriveProviders'
'*******************************************************************************
Private Function ReadRegistryProvider(ByVal oReg As Object _
                                    , ByVal regKey As String _
                                    , ByRef provider As OneDriveProvider)
    Const HKCU = &H80000001
    Dim cid As String
    Dim aFolder As String
    Dim relPath As String
    '
    With provider
        oReg.GetStringValue HKCU, regKey, "UrlNamespace", .urlNamespace
        oReg.GetStringValue HKCU, regKey, "MountPoint", .mountPoint
        oReg.GetStringValue HKCU, regKey, "CID", cid
        .cid = FixCID(cid)
        .isBusiness = Not (.urlNamespace = "https://d.docs.live.net")
        If .isBusiness Then
            If Right$(.urlNamespace, 1) = "/" Then
                .urlNamespace = Left$(.urlNamespace, Len(.urlNamespace) - 1)
            End If
        Else
            oReg.GetStringValue HKCU, regKey, "RelativePath", relPath
            .urlNamespace = .urlNamespace & "/" & .cid
            If LenB(relPath) = 0 Then
                .isSet = True
            Else
                .actualFolder = relPath
                .mountPoint = BuildPath(.mountPoint, relPath)
            End If
        End If
    End With
End Function
Private Function FixCID(ByVal cid As String) As String
    Dim i As Long: i = InStr(1, cid, "!")
    If i = 0 Then FixCID = cid Else FixCID = Left$(cid, i - 1)
End Function

'*******************************************************************************
'Utility for 'GetOneDriveProviders'
'*******************************************************************************
Private Sub FixProvidersFromSettings(ByRef providers() As OneDriveProvider)
    Const businessIniMask As String = "????????-????-????-????-????????????.ini"
    Const personalDatMask As String = "????????????????.dat"
    Const settingsRelPath As String = "Microsoft\OneDrive\settings\"
    Dim settingsPath As String
    Dim folderPath As Variant
    Dim folderName As String
    Dim iniName As String
    Dim iniPath As String
    Dim datName As String
    Dim datPath As String
    '
    settingsPath = BuildPath(Environ$("LOCALAPPDATA"), settingsRelPath)
    For Each folderPath In GetFolders(settingsPath)
        folderName = Right$(folderPath, Len(folderPath) - Len(settingsPath))
        If folderName Like "Business*" Then
            iniName = Dir(BuildPath(folderPath, businessIniMask))
            If LenB(iniName) > 0 Then
                iniPath = BuildPath(folderPath, iniName)
                datPath = Replace(iniPath, ".ini", ".dat")
                FixBusinessProviders iniPath, datPath, providers
            End If
        ElseIf folderName = "Personal" Then
            iniPath = BuildPath(settingsPath, "Personal\GroupFolders.ini")
            datName = Dir(BuildPath(folderPath, personalDatMask))
            If LenB(datName) > 0 And IsFile(iniPath) Then
                datPath = BuildPath(folderPath, datName)
                FixPersonalProviders iniPath, datPath, providers
            End If
        End If
    Next folderPath
End Sub

'*******************************************************************************
'Utility for 'FixProvidersFromSettings'
'*******************************************************************************
Private Sub FixBusinessProviders(ByVal iniPath As String _
                               , ByVal datPath As String _
                               , ByRef providers() As OneDriveProvider)
    Dim fileNumber As Long: fileNumber = FreeFile
    Dim lineText As String
    Dim arrParts() As String
    Dim tempMount As String
    Dim tempID As String
    Dim tempFolder As String
    Dim tempURL As String
    Dim i As Long
    Dim collFolders As Collection
    Dim collParents As Collection
    '
    Open iniPath For Input Access Read As #fileNumber
    Do While Not EOF(fileNumber)
        Line Input #fileNumber, lineText
        '
        Select Case Left$(lineText, InStr(1, lineText, " ") - 1)
        Case "libraryScope"
            arrParts = Split(lineText, """")
            If UBound(arrParts) >= 9 Then
                tempMount = arrParts(9)
                If LenB(tempMount) > 0 Then
                    tempURL = arrParts(5)
                    Do
                        i = FindBusinessProvider(providers, tURL, tempURL)
                        If i > 0 Then providers(i).isSet = True
                    Loop Until i = 0
                End If
            End If
        Case "libraryFolder"
            If collFolders Is Nothing Then
                Set collFolders = GetODFolders(datPath, collParents)
            End If
            arrParts = Split(lineText, """")
            tempMount = arrParts(1)
            i = FindBusinessProvider(providers, tMount, tempMount)
            If i > 0 Then
                tempID = Split(arrParts(0), " ")(4)
                tempID = Split(tempID, "+")(0)
                tempFolder = vbNullString
                On Error Resume Next
                Do
                    tempFolder = "/" & collFolders(tempID) & tempFolder
                    tempID = collParents(tempID)
                Loop Until Err.Number <> 0
                On Error GoTo 0
                If LenB(tempFolder) > 0 Then
                    With providers(i)
                        .urlNamespace = .urlNamespace & tempFolder
                        .isSet = True
                    End With
                End If
            End If
        Case "AddedScope"
            arrParts = Split(lineText, """")
            If UBound(arrParts) >= 3 Then
                tempURL = arrParts(1)
                i = FindBusinessProvider(providers, tURL, tempURL)
                If i > 0 Then
                    With providers(i)
                        .urlNamespace = .urlNamespace & "/" & arrParts(5)
                        .isSet = True
                    End With
                End If
            End If
        Case Else
            Exit Do
        End Select
    Loop
    Close #fileNumber
End Sub

'*******************************************************************************
'Utility for finding a provider that is not set
'*******************************************************************************
Private Function FindBusinessProvider(ByRef providers() As OneDriveProvider _
                                    , ByVal findType As ProviderFindType _
                                    , ByVal searchValue As String) As Long
    Dim i As Long
    Dim temp As String
    For i = LBound(providers) To UBound(providers)
        With providers(i)
            If Not .isSet Then
                Select Case findType
                    Case tCID:   temp = .cid
                    Case tMount: temp = .mountPoint
                    Case tURL:   temp = Left$(.urlNamespace, Len(searchValue))
                End Select
                If StrComp(temp, searchValue, vbTextCompare) = 0 Then
                    FindBusinessProvider = i
                    Exit Function
                End If
            End If
        End With
    Next i
End Function

'*******************************************************************************
'Utility for 'FixProvidersFromSettings'
'*******************************************************************************
Private Sub FixPersonalProviders(ByVal iniPath As String _
                               , ByVal datPath As String _
                               , ByRef providers() As OneDriveProvider)
    Dim s As String: s = ReadBytes(iniPath)
    If LenB(s) = 0 Then Exit Sub
    '
    Dim lines() As String: lines = Split(s, vbNewLine)
    Dim lineText As Variant
    Dim i As Long
    Dim cid As String
    Dim relPath As String
    Dim folderID As String
    Dim folderName As String
    Dim collFolders As Collection
    '
    For Each lineText In lines
        i = InStr(1, lineText, "_")
        If i > 0 Then
            Select Case Mid$(lineText, i + 1, InStr(i, lineText, " ") - i - 1)
            Case "BaseUri"
                cid = Mid$(lineText, InStrRev(lineText, "/") + 1)
            Case "Path"
                relPath = Mid$(lineText, InStr(lineText, " = ") + 3)
                folderID = Left$(lineText, i - 1)
                If collFolders Is Nothing Then
                    Set collFolders = GetODFolders(datPath)
                End If
                If collFolders.Count > 0 Then
                    folderName = collFolders(folderID)
                    i = FindPersonalProvider(providers, cid, folderName)
                    If i > 0 Then
                        With providers(i)
                            .urlNamespace = .urlNamespace & "/" & relPath
                            .isSet = True
                        End With
                    End If
                End If
            End Select
        End If
    Next lineText
End Sub

'*******************************************************************************
'Utility for finding a business provider that is not set
'*******************************************************************************
Private Function FindPersonalProvider(ByRef providers() As OneDriveProvider _
                                    , ByRef cid As String _
                                    , ByVal actualFolder As String) As Long
    Dim fCID As String: fCID = FixCID(cid)
    Dim i As Long
    For i = LBound(providers) To UBound(providers)
        With providers(i)
            If Not .isSet And Not .isBusiness Then
                If StrComp(.actualFolder, actualFolder, vbTextCompare) = 0 Then
                    If StrComp(.cid, cid, vbTextCompare) = 0 _
                    Or StrComp(.cid, fCID, vbTextCompare) = 0 Then
                        FindPersonalProvider = i
                        Exit Function
                    End If
                End If
            End If
        End With
    Next i
End Function

'*******************************************************************************
'Utility - Retrieves all folders from an OneDrive user .dat file
'*******************************************************************************
Private Function GetODFolders(ByVal filePath As String _
                            , Optional ByRef outParents As Collection) As Collection
    Dim s As String: s = ReadBytes(filePath)
    If LenB(s) = 0 Then Exit Function
    '
    Dim hFolder As String
    Dim hCheck As String
    Dim i As Long
    Dim stepSize As Long
    Dim bytes As Long
    Dim folderID As String
    Dim parentID As String
    Dim folderName As String
    Dim collFolders As New Collection
    '
    hFolder = ChrW$(&HAB02) & String$(3, ChrW$(&HABAB)) 'x02ABABABABABABAB
    i = InStrB(1, s, hFolder)
    If i > 0 Then
        stepSize = 16
    Else
        hFolder = Left$(hFolder, 2) 'x02ABABAB
        i = InStrB(1, s, hFolder)
        If i = 0 Then Exit Function
        stepSize = 8
    End If
    hCheck = ChrW$(&H1) & String(3, vbNullChar) 'x0100000000000000
    If outParents Is Nothing Then Set outParents = New Collection
    Do While i > 0
        i = i + stepSize
        If MidB$(s, i, 8) = hCheck Then
            i = i + 8
            bytes = InStrB(i, s, vbNullChar) - i
            folderID = StrConv(MidB$(s, i, bytes), vbUnicode)
            '
            i = i + 39
            bytes = InStrB(i, s, vbNullChar) - i
            parentID = StrConv(MidB$(s, i, bytes), vbUnicode)
            '
            i = i + 121
            bytes = -Int(-(InStrB(i, s, vbNullChar) - i) / 2) * 2
            folderName = MidB$(s, i, bytes)
            '
            collFolders.Add folderName, folderID
            outParents.Add parentID, folderID
        End If
        i = InStrB(i + 1, s, hFolder)
    Loop
    Set GetODFolders = collFolders
End Function

'*******************************************************************************
'Utility - Reads a file into an array of Bytes
'*******************************************************************************
Private Function ReadBytes(ByVal filePath As String) As Byte()
    Dim fileNumber As Long:    fileNumber = FreeFile
    Dim mustDelete As Boolean: mustDelete = Not IsFile(filePath)
    '
    Open filePath For Binary Access Read As #fileNumber
    ReDim ReadBytes(0 To LOF(fileNumber) - 1)
    Get fileNumber, , ReadBytes
    Close #fileNumber
    '
    If mustDelete Then DeleteFile filePath
End Function

[guwidoe]

Hi @cristianbuse

I'm glad and impressed that you seemingly managed to find a solution! The relevant tests are being passed here but there are still 4 that fail. I didn't look at the logic of your solution yet and therefore can only speculate why. For the first three ones, I have no idea why they fail:

FAILED Test Personal Business OneDrive shared by someone else (non-existent folder)
URL path: https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Test/
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Test\

FAILED Test Personal Business OneDrive shared by someone else (mounts to SharePoint on local sync!)
URL path: https://abconline-my.sharepoint.com/personal/operson_abc_at/Documents/Guido/Beispiel import.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\ABC\Person Other - Guido\Beispiel import.xlsm

FAILED Test Company SharePoint
URL path: https://abconline.sharepoint.com/sites/ACEA/Freigegebene Dokumente/General/2021/04_Working/- Archiv -/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\ABC\ACEA - General\2021\04_Working\- Archiv -\test.xlsm

The fourth one is a little trickier:

FAILED Test11 Private SharePoint (Business1 folder name because of supposed cunfusion in the registry, but the registry key just got overwritten)
URL path: https://d.docs.live.net/3dea8a9886f05935/Business1/test.xlsm
Func ret: 
act path: C:\Users\Witt-DörringGuidoABC\OneDrive\Business1\test.xlsm

Here I wanted to test what happens to the \Software\SyncEngines\Providers\OneDrive\ registry if I created a personal OneDrive folder called Business1. What actually happened is, that the weird Business1 Registry Key got overwritten with the key for the new personal mount point. But then, I logged out of my Business Account and then logged in again, now the Registry Key that was meant to store the information for the personal OneDrive Business1 folder was overwritten again! As you can see, the CID subkey of this folder is now a business-cid again!

Here is an example of an untampered one of the Business Keys that gets created when you log into a business OneDrive account:

As you can see, the one that represented a Personal mount point for a while has an additional sub key (RelativePath)

I hope this information helps you! As soon as I have time I'm going to try to perfect my independent solution incorporating your finds!

[cristianbuse]

Hi @guwidoe

Apologies for not coming back sooner!

I would assume that if you were to put a breakpoint after the providers = GetOneDriveProviders() line you would find that in the Locals window some of the providers are not set (mine are all set):

For the first 3 failed tests I would presume that they would have a libraryFolder entry in the business ini file. If they don't then maybe the logic in the libraryScope section (FixBusinessProviders method) is not correct which is causing the provider to be not set which later makes the main function return nothing. Could you please check?

As for the last one, I have no idea. I will wait for you to look into it.

Thanks!

[guwidoe]

Hello @cristianbuse,

Sorry for not replying sooner!

I now did as you said and as you predicted some of the providers seem to not be properly set. The libraryFolder lines in the .ini file do exist, however. One of those where the provider doesn't get set looks as follows:

libraryFolder = 3 10 d0553c25c3a74ae7901d0330e1ffa064+10 1651742148 "C:\Users\Witt-DörringGuidoABC\ABC\ACEA - General" 1 "General" fdafad6b-13ee-4fe6-88a1-89f82f1a764d 40532396646403835 1017134003 00000000-0000-0000-0000-000000000000 

I don't really have time to work on my own solution currently unfortunately but I want to point out, that it is not difficult to test a case like the Business1 folder yourself... Just create a folder called Business1 in your personal OneDrive, synchronize it, and then relog your Business account.

[cristianbuse]

Hi @guwidoe ,

I am sorry to ask for this but I have no way of knowing what goes wrong on your computer. Could you please add a break point on the i = FindBusinessProvider(providers, tMount, tempMount) line of the FixBusinessProviders method:

and then run the tests. Then press F5 until the tempMount variable shows the C:\Users\Witt-DörringGuidoABC\ABC\ACEA - General value in the Locals window. Then, by running code line by line, you should be able to see what line is failing. Maybe i = FindBusinessProvider(providers, tMount, tempMount) returns 0 or maybe tempID = Split(tempID, "+")(0) is not returning d0553c25c3a74ae7901d0330e1ffa064 or maybe the Do ... Loop does something wrong or the particular ID was not found in the dat file.

If you don't have the time to test this, I perfectly understand and I apologize in advance for asking.

Thank you again, your feedback was/is invaluable!

[guwidoe]

Hi @cristianbuse,

Of course, I'm glad I can help with the debugging!

It seems that the Do...Loop creating the tempFolder string exits on the first pass already and tempFolder remains empty.

I guess this means the ID wasn't found in the .dat file?

Maybe something is wrong with my .dat file...

[cristianbuse]

Thanks @guwidoe

The following code will save a text file on your Desktop:

Option Explicit

Sub DebugDat()
    Const businessIniMask As String = "????????-????-????-????-????????????.ini"
    Const settingsRelPath As String = "Microsoft\OneDrive\settings\Business1"
    Dim settingsPath As String
    Dim iniName As String
    Dim iniPath As String
    Dim datName As String
    Dim filePath As String
    '
    settingsPath = BuildPath(Environ$("LOCALAPPDATA"), settingsRelPath)
    iniName = Dir(BuildPath(settingsPath, businessIniMask))
    filePath = BuildPath(settingsPath, Replace(iniName, ".ini", ".dat"))
    '
    Dim s As String: s = ReadBytes(filePath)
    If LenB(s) = 0 Then Exit Sub
    '
    Dim hFolder As String
    Dim hCheck As String
    Dim i As Long
    Dim stepSize As Long
    Dim bytes As Long
    Dim folderID As String
    Dim parentID As String
    Dim folderName As String
    Dim collFolders As New Collection
    '
    hFolder = ChrW$(&HAB02) & String$(3, ChrW$(&HABAB)) 'x02ABABABABABABAB
    i = InStrB(1, s, hFolder)
    If i > 0 Then
        stepSize = 16
    Else
        hFolder = Left$(hFolder, 2) 'x02ABABAB
        i = InStrB(1, s, hFolder)
        If i = 0 Then Exit Sub
        stepSize = 8
    End If
    hCheck = ChrW$(&H1) & String(3, vbNullChar) 'x0100000000000000

    Do While i > 0
        i = i + stepSize
        If MidB$(s, i, 8) = hCheck Then
            i = i + 8
            bytes = InStrB(i, s, vbNullChar) - i
            folderID = StrConv(MidB$(s, i, bytes), vbUnicode)
            '
            i = i + 39
            bytes = InStrB(i, s, vbNullChar) - i
            parentID = StrConv(MidB$(s, i, bytes), vbUnicode)
            '
            i = i + 121
            bytes = -Int(-(InStrB(i, s, vbNullChar) - i) / 2) * 2
            folderName = MidB$(s, i, bytes)
            '
            collFolders.Add Join(Array(folderID, folderName, parentID), "<>")
        End If
        i = InStrB(i + 1, s, hFolder)
    Loop
    '
    Dim textToSave As String
    Dim v As Variant
    '
    For Each v In collFolders
        textToSave = textToSave & v & vbNewLine
    Next v
    '
    Dim fileNumber As Long: fileNumber = FreeFile
    Dim debugPath As String: debugPath = Environ("USERPROFILE") & "\Desktop\debugDAT.txt"
    '
    Open debugPath For Output Access Write As #fileNumber
    Print #fileNumber, textToSave
    Close #fileNumber
    On Error GoTo 0
End Sub
Private Function ReadBytes(ByVal filePath As String) As Byte()
    Dim fileNumber As Long:    fileNumber = FreeFile
    Dim mustDelete As Boolean: mustDelete = Not IsFile(filePath)
    '
    Open filePath For Binary Access Read As #fileNumber
    ReDim ReadBytes(0 To LOF(fileNumber) - 1)
    Get fileNumber, , ReadBytes
    Close #fileNumber
    '
    If mustDelete Then DeleteFile filePath
End Function

There would be folderID, folderName and parentID saved as delimited text (<> being the delimiter).

Can you please see if you can find the d0553c25c3a74ae7901d0330e1ffa064 id inside it. By using the parentID, it should be possible to find all the parent names in the list. At least this is what the Do loop does.

[guwidoe]

Hi @cristianbuse,

Thanks for that script, its very useful since my .dat file is about 150MB and a little difficult to look through!

As expected, I could not find the d0553c25c3a74ae7901d0330e1ffa064 id inside the created file.

[cristianbuse]

Thanks @guwidoe

Can you please check one more thing? Can you open the dat file directly in Notepad/Notepad++ and see if you can find the d0553c25c3a74ae7901d0330e1ffa064 id?

If you don't find it then that is super strange as the dat file should hold record of all folders including the ones that are not synchronized. I don't think this is the case.

If you do find it, then it means that the logic I used for finding the bytes must be updated. Maybe you have an older/newer OneDrive version. In this case, you could open the dat file in a hex editor and see if you can find the ID somewhere.

The ID should be preceded by a folder tag (x02ABABAB or x02ABABABABABABAB) that has a x010000000000000000 entry after 16 bytes. For example, if I were to look for ID ad6a01c3d1fc413380dd5838dccd2b45 then I should find something like:

[guwidoe]

Can you please check one more thing? Can you open the dat file directly in Notepad/Notepad++ and see if you can find the d0553c25c3a74ae7901d0330e1ffa064 id?

I already did that and unfortunately, I could not find said id.

Edit: I can't even find the mount point folder's name in the .dat file. Maybe I should try to relog my OneDrive

[cristianbuse]

Do you want me to look for the folder name instead?

Yes, please. It should be there in some form.

Also, maybe the encoding is different when you open it in Notepad. You could try to find the bytes directly in the hex editor. The d0553c25c3a74ae7901d0330e1ffa064 id would translate to 6430353533633235633361373461653739303164303333306531666661303634.

[guwidoe]

@cristianbuse

After playing around a little bit with encodings and what to look for I did now manage to find 266 occurrences of said id in the .dat file. Only the first occurrence is preceded by something similar to what you described:

[cristianbuse]

Thanks @guwidoe

This is bad news. What OD version do you have? Mine is Version 2022 (Build 22.131.0619.0001) (64-bit)

[guwidoe]

What OD version do you have?

[cristianbuse]

Interesting. I upgraded to the insider version (exact same version as yours) and the logic still works and all tests are passing on my end, even after restarting.

So, my best guess is that it has something to do with the encoding or locale of your dat file.

Could you share the result of the below script?

Option Explicit

Sub DebugID()
    Const businessIniMask As String = "????????-????-????-????-????????????.ini"
    Const settingsRelPath As String = "Microsoft\OneDrive\settings\Business1"
    Dim settingsPath As String
    Dim iniName As String
    Dim iniPath As String
    Dim datName As String
    Dim filePath As String
    Dim ID As String: ID = StrConv("d0553c25c3a74ae7901d0330e1ffa064", vbFromUnicode)
    '
    settingsPath = BuildPath(Environ$("LOCALAPPDATA"), settingsRelPath)
    iniName = Dir(BuildPath(settingsPath, businessIniMask))
    filePath = BuildPath(settingsPath, Replace(iniName, ".ini", ".dat"))
    '
    Dim s As String: s = ReadBytes(filePath)
    If LenB(s) = 0 Then Exit Sub
    '
    Dim i As Long
    Dim bytes As Long
    Dim textToSave As String
    '
    i = InStrB(1, s, ID)
    Do While i > 0
        textToSave = textToSave & vbNewLine & vbNewLine & StrConv(MidB(s, i - 28, 164), vbUnicode)
        i = InStrB(i + 1, s, ID)
    Loop
    '
    Dim fileNumber As Long: fileNumber = FreeFile
    Dim debugPath As String: debugPath = Environ("USERPROFILE") & "\Desktop\debugID.txt"
    '
    Open debugPath For Output Access Write As #fileNumber
    Print #fileNumber, textToSave
    Close #fileNumber
    On Error GoTo 0
End Sub
Private Function ReadBytes(ByVal filePath As String) As Byte()
    Dim fileNumber As Long:    fileNumber = FreeFile
    Dim mustDelete As Boolean: mustDelete = Not IsFile(filePath)
    '
    Open filePath For Binary Access Read As #fileNumber
    ReDim ReadBytes(0 To LOF(fileNumber) - 1)
    Get fileNumber, , ReadBytes
    Close #fileNumber
    '
    If mustDelete Then DeleteFile filePath
End Function

Besides the few folder/file names there should be nothing that is sensitive. Anyway, in case there is you could replace the names in the text file before sharing. Please let me know if this is possible? Thank you!

[guwidoe]

I didn't change anything in the file, I don't think it contains anything sensitive. I hope this helps! debugID.txt