GetLocalPath fails with Error

[guwidoe]

Hello, my old friend, the quest for the perfect GetLocalPath function seems never-ending!

Before I tell you on which line the code fails, let me explain how I have set up certain folder syncs. I'm sure then it'll be obvious to you where the problem is.

I tried testing for this back in the day when developing my function but I didn't manage to set it up, as it is a bit tedious.

First of all, you need two different Business accounts from different organizations. (Actually, I'm not sure what happens if they are both from the same organization, I think the problem can still occur, but fixing it for the case of two different organizations (as on my PC) should also fix it for the same organization case.) These accounts must both be logged into OneDrive on the same PC. So far this is nothing new. To explain the setup, in the following I will refer to one of the accounts as Business1 and the other one as Business2. There are actually multiple ways the problem can play out:

Case 1:

1. Business2 owns a library called LibName on their SharePoint. Business2 has a folder bar of that Library synced locally. The WebPath will look something like ...LibUrlName/Documents/foo/bar/ the LocalPath might be ...SharePointBusiness2\LibName - bar\.
2. now the Business2 account grants the Business1 account access to this Library! If you open the folder bar in the browser while logged into your Business1 account in the browser, you will be given the option to synchronize again! You can do that and end up with a second local path like ...SharePointBusiness2\TeamSite - bar\ for the exact same WebPath.

In your solution, this will lead to an error 457 in the procedure AddBusinessPaths:

In my solution it will lead to the same error 457 here:

Of course, on the one hand, this is a huge problem, because it means our problem is not bijective anymore, on the other hand, picking either of the possible LocalPaths should be fine from a user perspective since the two directories are identical mirrors locally as well as on the server.

But there are more ways, in which this mechanic can be problematic, I'll first describe those before I present my solution ideas. Second scenario (quite similar, differences are formatted italic)

Case 2:

1. Business2 owns a library called LibName on their SharePoint. Business2 has a folder bar of that Library added as a link (addedScope) to their personal folder. The WebPath will look the same like ...LibUrlName/Documents/foo/bar/ the LocalPath might be ...OneDrive - Business2\bar - LibName\.
2. now the Business2 account grants the Business1 account access to this Library again. If you open the folder bar in the browser while logged into your Business1 account in the browser, you will be given the option to synchronize again! You can do that and end up with a second local path like ...SharePointBusiness2\LibName - bar\ for the exact same WebPath.

In this case, the problem manifests in the same way as in Case1.

The next case implements something I thought was impossible here. Since we are now able to synchronize the same WebPath twice, we can also synchronize it at different levels of the folder structure!

Case 3:

1. Business2 owns a library called LibName on their SharePoint. Business2 has a folder bar of that Library synced locally. The WebPath will look something like ...LibUrlName/Documents/foo/bar/ the LocalPath might be ...SharePointBusiness2\LibName - bar\.
2. now the Business2 account grants the Business1 account access to this Library! If you open the folder foo in the browser while logged into your Business1 account in the browser, you will be given the option to synchronize again! You can do that and end up with a second local path like ...SharePointBusiness2\TeamSite - foo\ for a similar WebPath (synchronized at a different level!).

This case does not produce an error in my current implementation but it just picks one of the two local paths at random, whichever appears first in the result dictionary. This case can also be implemented like in Case 2 (using the addedScope)

What options do we have for solving this problem?

In my implementation, a "lazy" solution would be something like replacing the line

WebToLocDict.Add Key:=webRoot, item:=locRoot

with

WebToLocDict(webRoot) = locRoot

This would just pick one of the possible LocalPaths for a given WebPath essentially at random. In my opinion this solution is not satisfying.

Another solution would be, to give the user the option to return all valid LocalPaths for a given WebPath, for instance like this:

If returnAll then
    If WebToLocDict.Exists(webRoot) then
        WebToLocDict(webRoot) = WebToLocDict(webRoot) & "/" & locRoot
    Else
        WebToLocDict.Add Key:=webRoot, item:=locRoot
   End If
Else
    WebToLocDict(webRoot) = locRoot
End If

What if the same WebPathwas mounted at two different levels? One solution would be to take the solution with the lowest level mountpoint, as you suggested here

Then there is another way which I personally like most: Because we know by which user the mount point was created (it will show up in their respective cid.ini files in the settings directory), we could check for the current Application.UserName, and if it is the owner of one of the possible local mount points, we could return that one.

In the end, there is no "right" way to continue from here, I think the ideal solution combines some of my proposed solutions here. Maybe like: If the current Application.UserName owns one of the mount points, return that, if not, return the one mounted at the lowest point per default, if they are mounted at the same level, return any one. Maybe pass an optional parameter to the function that lets users choose, or lets the function return all possible matches. The latter one is especially useful for testing in my opinion because then the function is bijective again if you sort the possible local paths for instance alphabetically. In the real world, I don't think it's very often useful to have the function return all the possible local paths.

I hope I explained the problem in an understandable way. I understand that this will be very difficult for you to test, but I think you should still be able to solve it. Let me know how you decide to solve it. I think best would be optional parameters for the function where I can set the default to return all the possible local paths, sorted alphabetically and delimited by a forward slash. Then I could update my tests accordingly and easily run them for you.

For the production code, I think the default parameters should lead to a behavior like this: If the current Application.UserName owns one of the mount points, return that, if not, return the one mounted at the lowest point, if all are mounted at the same level, return any one.

[guwidoe]

Hi @cristianbuse,

I now implemented a version of my function without using the registry too. Regarding the aforementioned problem, I only implemented my above-described "lazy" solution so far. Since I obviously changed quite a lot from my last version, I would like to ask you to test my new function to further confirm I haven't broken anything in the process of making it registry-independent.

When this is confirmed, I'll try to implement some of my ideas from the first post.

Unfortunately, it grew a little longer at now 239 lines of code compared to the 191 lines of code of my newest registry-dependent version.

Public Function GetLocalPath(ByVal Path As String, _
                    Optional ByVal rebuildCache As Boolean = False) _
                             As String
#If Mac Then
    GetLocalPath = Path: Exit Function
#End If
    Dim webRoot As String, locRoot As String, vKey As Variant, vItem As Variant

    Static WebToLocDict As Object
    If Not WebToLocDict Is Nothing And Not rebuildCache Then
        For Each vKey In WebToLocDict.Keys
            If InStr(1, Path, vKey, vbBinaryCompare) = 1 Then
                Path = Replace(Path, vKey, WebToLocDict(vKey), , 1)
                GetLocalPath = Replace(Path, "/", "\"): Exit Function
            End If
        Next vKey
        GetLocalPath = Path: Exit Function
    End If

    Dim LocToWebDict As Object
    Set LocToWebDict = CreateObject("Scripting.Dictionary")

    Dim cid As String, fileNumber As Long, line As Variant, parts() As String
    Dim tag As String, mainMount As String
    Dim b() As Byte, n As Long, i As Long, s As String, size As Long
    Dim sig1 As String: sig1 = StrConv(Chr$(&H2), vbFromUnicode)
    Dim sig2 As String: sig2 = ChrW$(&H1) & String(3, vbNullChar)
    Dim vbNullByte As String: vbNullByte = MidB$(vbNullChar, 1, 1)
    Dim parentID As String, folderID As String, folderName As String
    Dim lenFolderName As Long, folderIdPattern As String, fileName As String
    Dim siteID As String, irmLibId As String, webID As String
    Dim odFolders As Object, CliPolDict As Object

    Dim settPath As String, wDir As String
    settPath = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\"

    'Find all subdirectories in OneDrive settings folder:
    Dim OneDriveSettDirs As Collection: Set OneDriveSettDirs = New Collection
    Dim dirName As Variant: dirName = Dir(settPath, vbDirectory)
    Do Until dirName = ""
        If dirName = "Personal" Or dirName Like "Business#" Then _
            OneDriveSettDirs.Add dirName
        dirName = Dir(, vbDirectory)
    Loop

    'Refining the dict using .ini and .dat files in the OneDrive settings:
    For Each dirName In OneDriveSettDirs
        wDir = settPath & dirName & "\"
        'Read global.ini to get cid
        If Dir(wDir & "global.ini", vbNormal) = "" Then GoTo NextFolder
        fileNumber = FreeFile()
        Open wDir & "global.ini" For Binary Access Read As #fileNumber
        ReDim b(0 To LOF(fileNumber)): Get fileNumber, , b
        Close #fileNumber: fileNumber = 0
        For Each line In Split(b, vbNewLine)
            parts = Split(line, " = ")
            If parts(0) = "cid" Then: cid = parts(1): Exit For
        Next line

        If cid = "" Then GoTo NextFolder
        If dirName Like "Business#" Then
            If (Dir(wDir & cid & ".ini") = "" Or _
                Dir(wDir & cid & ".dat") = "") Then GoTo NextFolder
            folderIdPattern = Replace(Space(32), " ", "[a-f0-9]")
        ElseIf dirName = "Personal" Then
            If Dir(wDir & "GroupFolders.ini") = "" Then GoTo NextFolder
            folderIdPattern = Replace(Space(16), " ", "[A-F0-9]") & "!###*"
        End If

        'Read all the ClientPloicy.ini files:
        Set CliPolDict = CreateObject("Scripting.Dictionary")
        fileName = Dir(wDir, vbNormal)
        Do Until fileName = ""
            If fileName Like "ClientPolicy*.ini" Then
                fileNumber = FreeFile()
                Open wDir & fileName For Binary Access Read As #fileNumber
                ReDim b(0 To LOF(fileNumber)): Get fileNumber, , b: s = b
                Close #fileNumber: fileNumber = 0
                Set CliPolDict(fileName) = CreateObject("Scripting.Dictionary")
                For Each line In Split(b, vbNewLine)
                    If InStr(1, line, " = ", vbBinaryCompare) Then
                        parts = Split(line, " = "): tag = parts(0)
                        s = Replace(line, tag & " = ", "", , 1)
                        Select Case tag
                        Case "DavUrlNamespace"
                            CliPolDict(fileName).Add Key:=tag, item:=s
                        Case "SiteID"
                            s = Replace(LCase(s), "-", "")
                            If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
                            CliPolDict(fileName).Add Key:=tag, item:=s
                        Case "IrmLibraryId"
                            s = Replace(LCase(s), "-", "")
                            If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
                            CliPolDict(fileName).Add Key:=tag, item:=s
                        Case "WebID"
                            s = Replace(LCase(s), "-", "")
                            If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
                            CliPolDict(fileName).Add Key:=tag, item:=s
                        End Select
                    End If
                Next line
            End If
            fileName = Dir
        Loop

        'Read dirName\cid.dat file
        fileNumber = FreeFile
        Open wDir & cid & ".dat" For Binary Access Read As #fileNumber
       ReDim b(0 To LOF(fileNumber)): Get fileNumber, , b: s = b: size = LenB(s)
        Close #fileNumber: fileNumber = 0
        Set odFolders = CreateObject("Scripting.Dictionary")
        For Each vItem In Array(16, 8) 'vItem = stepSize
            i = InStrB(vItem, s, sig2)
            Do While i > vItem And i < size - 168
                If MidB$(s, i - vItem, 1) = sig1 Then
                    i = i + 8: n = InStrB(i, s, vbNullByte) - i
                    If n < 0 Then n = 0: If n > 39 Then n = 39
                    folderID = StrConv(MidB$(s, i, n), vbUnicode)
                    i = i + 39: n = InStrB(i, s, vbNullByte) - i
                    If n < 0 Then n = 0: If n > 39 Then n = 39
                    parentID = StrConv(MidB$(s, i, n), vbUnicode)
                    i = i + 121
                    n = -Int(-(InStrB(i, s, vbNullChar) - i) / 2) * 2
                    If n < 0 Then n = 0
                    folderName = MidB$(s, i, n)
                    If folderID Like folderIdPattern Then
                        odFolders.Add Key:=folderID, _
                                      item:=Array(parentID, folderName)
                    End If
                End If
                i = InStrB(i + 1, s, sig2)
            Loop
            If odFolders.count > 0 Then Exit For
        Next vItem

        'Read relevant .ini files
        fileNumber = FreeFile()
        Open wDir & cid & ".ini" For Binary Access Read As #fileNumber
        ReDim b(0 To LOF(fileNumber)): Get fileNumber, , b
        Close #fileNumber: fileNumber = 0
        Select Case True
        Case dirName Like "Business#"
        'Max 9 Business OneDrive accounts can be signed in at a time.
            mainMount = ""
            For Each line In Split(b, vbNewLine)
                Select Case left$(line, InStr(line, " = ") - 1)
                Case "libraryScope"
                    parts = Split(line, """"): locRoot = parts(9)
                    If locRoot = "" Then locRoot = Split(line, " ")(2)
                    If mainMount = "" Then mainMount = locRoot
                    Debug.Assert Not mainMount Like "#*"
                    i = LocToWebDict.count(): parts = Split(parts(8), " ")
                    siteID = parts(1): webID = parts(2): irmLibId = parts(3)
                    For Each vItem In CliPolDict.Items
                        If vItem("SiteID") = siteID And vItem("WebID") = webID _
                        And vItem("IrmLibraryId") = irmLibId Then
                            LocToWebDict.Add Key:=locRoot, _
                                             item:=vItem("DavUrlNamespace")
                            Exit For
                        End If
                    Next vItem
                    Debug.Assert LocToWebDict.count() = i + 1
                Case "libraryFolder"
                    locRoot = Split(line, " ")(3)
                    parentID = left(Split(line, " ")(4), 32)
                    For Each vKey In LocToWebDict.Keys
                        If vKey = locRoot Then
                            s = ""
                            Do Until Not odFolders.Exists(parentID)
                                s = odFolders(parentID)(1) & "/" & s
                                parentID = odFolders(parentID)(0)
                            Loop
                            LocToWebDict.Add Key:=Split(line, """")(1), _
                                             item:=LocToWebDict(vKey) & s
                            Exit For
                        End If
                    Next vKey
                Case "AddedScope"
                    webRoot = "": parts = Split(Split(line, """")(4), " ")
                    siteID = parts(1): webID = parts(2): irmLibId = parts(3)
                    For Each vItem In CliPolDict.Items
                        If vItem("SiteID") = siteID And vItem("WebID") = webID _
                        And vItem("IrmLibraryId") = irmLibId Then: _
                            webRoot = vItem("DavUrlNamespace") & _
                                        Split(line, """")(5): Exit For
                    Next vItem
                    Debug.Assert webRoot <> ""
                    locRoot = mainMount & "\" & _
                                    odFolders(left(Split(line, " ")(3), 32))(1)
                    LocToWebDict.Add Key:=locRoot, item:=webRoot
                Case Else
                    For Each vKey In LocToWebDict.Keys
                        If vKey Like "#*" Then LocToWebDict.Remove vKey
                    Next vKey
                    Exit For
                End Select
            Next line
        Case dirName = "Personal"
        'Only one Personal OneDrive account can be signed in at a time.
            If Not CliPolDict.Exists("ClientPolicy.ini") Then GoTo NextFolder
            For Each line In Split(b, vbNewLine)
                If line Like "library = *" Then _
                    locRoot = Split(line, """")(3): Exit For
            Next line
            webRoot = CliPolDict("ClientPolicy.ini")("DavUrlNamespace")
            LocToWebDict(locRoot) = webRoot & "/" & cid
            cid = ""
            fileNumber = FreeFile()
            Open wDir & "GroupFolders.ini" For Binary Access Read As #fileNumber
            ReDim b(0 To LOF(fileNumber)): Get fileNumber, , b
            Close #fileNumber: fileNumber = 0
            For Each line In Split(b, vbNewLine)
                If InStr(line, "BaseUri = https://") And cid = "" Then
                    cid = LCase(Mid(line, InStrRev(line, "/") + 1, 16))
                    folderID = left(line, InStr(line, "_") - 1)
                ElseIf cid <> "" Then
                    LocToWebDict.Add _
                        Key:=locRoot & "\" & odFolders(folderID)(1), _
                        item:=webRoot & "/" & cid & "/" & _
                              Replace(line, folderID & "_Path = ", "")
                    cid = "": folderID = ""
                End If
            Next line
        End Select
NextFolder:
        cid = "": s = "": Set odFolders = Nothing
    Next dirName

    Set WebToLocDict = Nothing
    Set WebToLocDict = CreateObject("Scripting.Dictionary")
    For Each vKey In LocToWebDict.Keys
        locRoot = vKey: webRoot = LocToWebDict(vKey)
       If right(locRoot, 1) = "\" Then locRoot = left(locRoot, Len(locRoot) - 1)
       If right(webRoot, 1) = "/" Then webRoot = left(webRoot, Len(webRoot) - 1)
        WebToLocDict(webRoot) = locRoot
    Next vKey

    GetLocalPath = GetLocalPath(Path, False): Exit Function
End Function

[cristianbuse]

Hi @guwidoe ,

Your function still passes all my tests.

I managed to get a second business account and replicate all your cases.

However, I went a step further. Consider these 2 scenarios:

Scenario 1 Business2 shares folder Test with Business1 but only with Read-Only permissions. The Business1 then adds a shortcut to the parent of the Test folder. Now we have a collision where two local folders are syncronized to the same URL.

If Application.UserName returns the name corresponding to Business1 then we certainly don't want to return the path to the Business1 folder as that only has Read-Only permissions. We want the path to the Business2 folder. One use case would be that we want to create a file in the same folder as a workbook we have opened and so based on the FullName property of the book, we want GetLocalPath to return the path to the folder with Edit permissions.

Scenario 2 Business2 shares folder Test with Business1 but only with Read-Only permissions. The Business1 then synchronizes the subfolder Test\Test\Test. Now we have no collision as the URLs are different. However, even though the longest path (lowest level mountpoint) might match the Business1 local sync we want to return the local path for the Business2 folder for the exact same reason in scenario 1.

So, I think regardless if Read-Only or Edit mode, we should always return the local path for the business account which owns the files. Please let me know your thoughts on this.

Also, I found that in scenario 1, the AddedScope line in Account1 can have a space (i.e. " ") in the last part (i.e. the relative path) so it needs to be dealt with in code.

[cristianbuse]

@guwidoe

I just though of something else. In both scenario 1 and 2 presented above, the Business2 account might not have the shared folder as syncronized (Settings/Account/Choose folders) so that would become an issue.

So, I think I would go for this: Scenario 1 If Test folder exists in the Bussiness2 location then definitely return that. Otherwise return the Business1 location

Scenario 2 If Test\Test\Test folder exists in the Bussiness2 location then definitely return that. Otherwise return the Business1 location

[guwidoe]

Hi @cristianbuse,

I agree with the points you are making. Then the rules for the perfect function should be: If the folder is synchronized by the owner, return that path. Otherwise, follow the logic I described in my first post, including the rule that syncs with Edit rights are preferred.

Also, I found that in scenario 1, the AddedScope line in Account1 can have a space (i.e. " ") in the last part (i.e. the relative path) so it needs to be dealt with in code.

Thanks for this hint. I'll try to test it.

I have another hint regarding the addedScope lines for you: Once you have the link added to your MySite folder, you can move it however you please, you can also move it into other folders:

Luckily we can also deal with this thanks to the folder information we got from the .dat file, and in my newest solution I have already implemented this and it can deal with such cases. Maybe you can test it again :)

Edit: fixed bug related to space (i.e. " ") in the last part of addedScope lines

Public Function GetLocalPath(ByVal Path As String, _
                    Optional ByVal rebuildCache As Boolean = False, _
                    Optional ByVal returnAll As Boolean = True) _
                             As String
#If Mac Then
    GetLocalPath = Path: Exit Function
#End If
    Dim webRoot As String, locRoot As String, vKey As Variant, vItem As Variant

    Static WebToLocDict As Object
    If Not WebToLocDict Is Nothing And Not rebuildCache Then
        For Each vKey In WebToLocDict.Keys
            If InStr(1, Path, vKey, vbBinaryCompare) = 1 Then
                Path = Replace(Path, vKey, WebToLocDict(vKey), , 1)
                GetLocalPath = Replace(Path, "/", "\"): Exit Function
            End If
        Next vKey
        GetLocalPath = Path: Exit Function
    End If

    Dim LocToWebDict As Object
    Set LocToWebDict = CreateObject("Scripting.Dictionary")

    Dim cid As String, fileNumber As Long, line As Variant, parts() As String
    Dim tag As String, mainMount As String, relPath As String
    Dim b() As Byte, n As Long, i As Long, s As String, size As Long
    Dim sig1 As String: sig1 = StrConv(Chr$(&H2), vbFromUnicode)
    Dim sig2 As String: sig2 = ChrW$(&H1) & String(3, vbNullChar)
    Dim vbNullByte As String: vbNullByte = MidB$(vbNullChar, 1, 1)
    Dim parentID As String, folderID As String, folderName As String
    Dim lenFolderName As Long, folderIdPattern As String, fileName As String
    Dim siteID As String, irmLibId As String, webID As String
    Dim odFolders As Object, CliPolDict As Object

    Dim settPath As String, wDir As String
    settPath = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\"

    'Find all subdirectories in OneDrive settings folder:
    Dim OneDriveSettDirs As Collection: Set OneDriveSettDirs = New Collection
    Dim dirName As Variant: dirName = Dir(settPath, vbDirectory)
    Do Until dirName = ""
        If dirName = "Personal" Or dirName Like "Business#" Then _
            OneDriveSettDirs.Add dirName
        dirName = Dir(, vbDirectory)
    Loop

    'Writing LocToWebDict using .ini and .dat files in the OneDrive settings:
    For Each dirName In OneDriveSettDirs
        wDir = settPath & dirName & "\"
        'Read global.ini to get cid
        If Dir(wDir & "global.ini", vbNormal) = "" Then GoTo NextFolder
        fileNumber = FreeFile()
        Open wDir & "global.ini" For Binary Access Read As #fileNumber
        ReDim b(0 To LOF(fileNumber)): Get fileNumber, , b
        Close #fileNumber: fileNumber = 0
        For Each line In Split(b, vbNewLine)
            parts = Split(line, " = ")
            If parts(0) = "cid" Then: cid = parts(1): Exit For
        Next line

        If cid = "" Then GoTo NextFolder
        If dirName Like "Business#" Then
            If (Dir(wDir & cid & ".ini") = "" Or _
                Dir(wDir & cid & ".dat") = "") Then GoTo NextFolder
            folderIdPattern = Replace(Space(32), " ", "[a-f0-9]")
        ElseIf dirName = "Personal" Then
            If Dir(wDir & "GroupFolders.ini") = "" Then GoTo NextFolder
            folderIdPattern = Replace(Space(16), " ", "[A-F0-9]") & "!###*"
        End If

        'Read all the ClientPloicy.ini files:
        Set CliPolDict = CreateObject("Scripting.Dictionary")
        fileName = Dir(wDir, vbNormal)
        Do Until fileName = ""
            If fileName Like "ClientPolicy*.ini" Then
                fileNumber = FreeFile()
                Open wDir & fileName For Binary Access Read As #fileNumber
                ReDim b(0 To LOF(fileNumber)): Get fileNumber, , b: s = b
                Close #fileNumber: fileNumber = 0
                Set CliPolDict(fileName) = CreateObject("Scripting.Dictionary")
                For Each line In Split(b, vbNewLine)
                    If InStr(1, line, " = ", vbBinaryCompare) Then
                        parts = Split(line, " = "): tag = parts(0)
                        s = Replace(line, tag & " = ", "", , 1)
                        Select Case tag
                        Case "DavUrlNamespace"
                            CliPolDict(fileName).Add Key:=tag, Item:=s
                        Case "SiteID"
                            s = Replace(LCase(s), "-", "")
                            If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
                            CliPolDict(fileName).Add Key:=tag, Item:=s
                        Case "IrmLibraryId"
                            s = Replace(LCase(s), "-", "")
                            If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
                            CliPolDict(fileName).Add Key:=tag, Item:=s
                        Case "WebID"
                            s = Replace(LCase(s), "-", "")
                            If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
                            CliPolDict(fileName).Add Key:=tag, Item:=s
                        End Select
                    End If
                Next line
            End If
            fileName = Dir
        Loop

        'Read dirName\cid.dat file
        fileNumber = FreeFile
        Open wDir & cid & ".dat" For Binary Access Read As #fileNumber
       ReDim b(0 To LOF(fileNumber)): Get fileNumber, , b: s = b: size = LenB(s)
        Close #fileNumber: fileNumber = 0
        Set odFolders = CreateObject("Scripting.Dictionary")
        For Each vItem In Array(16, 8) 'vItem = stepSize
            i = InStrB(vItem, s, sig2)
            Do While i > vItem And i < size - 168
                If MidB$(s, i - vItem, 1) = sig1 Then
                    i = i + 8: n = InStrB(i, s, vbNullByte) - i
                    If n < 0 Then n = 0: If n > 39 Then n = 39
                    folderID = StrConv(MidB$(s, i, n), vbUnicode)
                    i = i + 39: n = InStrB(i, s, vbNullByte) - i
                    If n < 0 Then n = 0: If n > 39 Then n = 39
                    parentID = StrConv(MidB$(s, i, n), vbUnicode)
                    i = i + 121
                    n = -Int(-(InStrB(i, s, vbNullChar) - i) / 2) * 2
                    If n < 0 Then n = 0
                    folderName = MidB$(s, i, n)
                    If folderID Like folderIdPattern Then
                        odFolders.Add Key:=folderID, _
                                      Item:=Array(parentID, folderName)
                    End If
                End If
                i = InStrB(i + 1, s, sig2)
            Loop
            If odFolders.count > 0 Then Exit For
        Next vItem

        'Read relevant .ini files
        fileNumber = FreeFile()
        Open wDir & cid & ".ini" For Binary Access Read As #fileNumber
        ReDim b(0 To LOF(fileNumber)): Get fileNumber, , b
        Close #fileNumber: fileNumber = 0
        Select Case True
        Case dirName Like "Business#"
        'Max 9 Business OneDrive accounts can be signed in at a time.
            mainMount = ""
            For Each line In Split(b, vbNewLine)
                Select Case left$(line, InStr(line, " = ") - 1)
                Case "libraryScope"
                    parts = Split(line, """"): locRoot = parts(9)
                    If locRoot = "" Then locRoot = Split(line, " ")(2)
                    i = LocToWebDict.count(): parts = Split(parts(8), " ")
                    siteID = parts(1): webID = parts(2): irmLibId = parts(3)
                    If mainMount = "" Then
                        mainMount = locRoot
                        Debug.Assert Not mainMount Like "#*"
                        If CliPolDict.Exists("ClientPolicy.ini") Then: _
                            LocToWebDict.Add Key:=locRoot, _
                         Item:=CliPolDict("ClientPolicy.ini")("DavUrlNamespace")
                    Else
                        If CliPolDict.Exists("ClientPolicy_" & irmLibId & _
                                 siteID & ".ini") Then: _
                            LocToWebDict.Add Key:=locRoot, _
                               Item:=CliPolDict("ClientPolicy_" & irmLibId & _
                                     siteID & ".ini")("DavUrlNamespace")
                    End If
                    Debug.Assert LocToWebDict.count() = i + 1
                    If Not LocToWebDict.count() = i + 1 Then
                        For Each vItem In CliPolDict.Items
                            If vItem("SiteID") = siteID And vItem("WebID") = _
                            webID And vItem("IrmLibraryId") = irmLibId Then
                                LocToWebDict.Add Key:=locRoot, _
                                                 Item:=vItem("DavUrlNamespace")
                                Exit For
                            End If
                        Next vItem
                    End If
                    Debug.Assert LocToWebDict.count() = i + 1
                Case "libraryFolder"
                    locRoot = Split(line, " ")(3)
                    For Each vKey In LocToWebDict.Keys
                        If vKey = locRoot Then
                            s = "": parentID = left(Split(line, " ")(4), 32)
                            Do Until Not odFolders.Exists(parentID)
                                s = odFolders(parentID)(1) & "/" & s
                                parentID = odFolders(parentID)(0)
                            Loop
                            LocToWebDict.Add Key:=Split(line, """")(1), _
                                             Item:=LocToWebDict(vKey) & s
                            Exit For
                        End If
                    Next vKey
                Case "AddedScope"
                    webRoot = "": parts = Split(line, """")
                    relPath = parts(5): If relPath = " " Then relPath = ""
                    parts = Split(parts(4), " ")
                    siteID = parts(1): webID = parts(2): irmLibId = parts(3)
                    If CliPolDict.Exists("ClientPolicy_" & irmLibId & _
                                 siteID & parts(4) & ".ini") Then: _
                        webRoot = CliPolDict("ClientPolicy_" & irmLibId & _
                                siteID & parts(4) & ".ini")("DavUrlNamespace") _
                                & relPath
                    Debug.Assert webRoot <> ""
                    If webRoot = "" Then
                        For Each vItem In CliPolDict.Items
                            If vItem("SiteID") = siteID And vItem("WebID") = _
                            webID And vItem("IrmLibraryId") = irmLibId Then: _
                                webRoot = vItem("DavUrlNamespace") & _
                                          relPath: Exit For
                        Next vItem
                    End If
                    Debug.Assert webRoot <> ""
                    s = "": parentID = left(Split(line, " ")(3), 32)
                    Do Until Not odFolders.Exists(parentID)
                        s = odFolders(parentID)(1) & "\" & s
                        parentID = odFolders(parentID)(0)
                    Loop
                    locRoot = mainMount & "\" & s
                    LocToWebDict.Add Key:=locRoot, Item:=webRoot
                Case Else
                    For Each vKey In LocToWebDict.Keys
                        If vKey Like "#*" Then LocToWebDict.Remove vKey
                    Next vKey
                    Exit For
                End Select
            Next line
        Case dirName = "Personal"
        'Only one Personal OneDrive account can be signed in at a time.
            If Not CliPolDict.Exists("ClientPolicy.ini") Then GoTo NextFolder
            For Each line In Split(b, vbNewLine)
                If line Like "library = *" Then _
                    locRoot = Split(line, """")(3): Exit For
            Next line
            webRoot = CliPolDict("ClientPolicy.ini")("DavUrlNamespace")
            LocToWebDict(locRoot) = webRoot & "/" & cid
            cid = ""
            fileNumber = FreeFile()
            Open wDir & "GroupFolders.ini" For Binary Access Read As #fileNumber
            ReDim b(0 To LOF(fileNumber)): Get fileNumber, , b
            Close #fileNumber: fileNumber = 0
            For Each line In Split(b, vbNewLine)
                If InStr(line, "BaseUri = https://") And cid = "" Then
                    cid = LCase(Mid(line, InStrRev(line, "/") + 1, 16))
                    folderID = left(line, InStr(line, "_") - 1)
                ElseIf cid <> "" Then
                    LocToWebDict.Add _
                        Key:=locRoot & "\" & odFolders(folderID)(1), _
                        Item:=webRoot & "/" & cid & "/" & _
                              Replace(line, folderID & "_Path = ", "")
                    cid = "": folderID = ""
                End If
            Next line
        End Select
NextFolder:
        cid = "": s = "": Set odFolders = Nothing
    Next dirName

    Set WebToLocDict = Nothing
    Set WebToLocDict = CreateObject("Scripting.Dictionary")
    For Each vKey In LocToWebDict.Keys
        locRoot = vKey: webRoot = LocToWebDict(vKey)
       If right(locRoot, 1) = "\" Then locRoot = left(locRoot, Len(locRoot) - 1)
       If right(webRoot, 1) = "/" Then webRoot = left(webRoot, Len(webRoot) - 1)
       'If Not WebToLocDict.Exists(webRoot) Then: _

        WebToLocDict(webRoot) = locRoot
    Next vKey

    GetLocalPath = GetLocalPath(Path, False): Exit Function
End Function

[cristianbuse]

Hi @guwidoe ,

I just pushed to the repository. Can you please test and see if it works for you?

I've replaced the collections with private types as I needed to hold more information on the business providers.

For personal providers I haven't changed anything really. For business providers it now matches based on the UrlNamespace only (not full URL) and if multiple matches are found then from the deepest level up it checks if the folder exists in all of the matched providers. If the deepest found folder exists in multiple mount point then it either picks the source business account (main) or the longest match. Reading the GetOneDriveLocalPath method should clarify the order. So now the path returns is also depending if the respective folder is ticked or not in the Choose Folders menu.

Oh, and I also fixed the 'added scope' so that links can be moved around.

Thanks!

[guwidoe]

Hi @cristianbuse,

I just tested the current code and there seem to be some bugs in it. 30/36 tests pass, here are the problematic ones:

FAILED Test Business SharePoint Library (3rd level mount) (file exists)
URL path: https://tuwienacat.sharepoint.com/sites/TestLib3rdLvlMount/Freigegebene Dokumente/2ndLevel/3rdLevel/test.xlsm
Func ret: C:\Users\Witt-DörringGuido\TU Wien\TestLib3rdLvlMount - Level6\
act path: C:\Users\Witt-DörringGuido\TU Wien\TestLib3rdLvlMount - 3rdLevel\test.xlsm

FAILED Test Business SharePoint Library (3rd level mount) (file exists)
URL path: https://tuwienacat.sharepoint.com/sites/TestLib3rdLvlMount/Freigegebene Dokumente/Test/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuido\TU Wien\TestLib3rdLvlMount - Level6\
act path: C:\Users\Witt-DörringGuido\TU Wien\TestLib3rdLvlMount - Test\test.xlsm

FAILED Test Business SharePoint Library (3rd level mount) (file exists)
URL path: https://tuwienacat.sharepoint.com/sites/InitialName/Freigegebene Dokumente/2ndLevel/3rdLevel/test.xlsm
Func ret: C:\Users\Witt-DörringGuido\TU Wien\ChangedName - Test\lsm
act path: C:\Users\Witt-DörringGuido\TU Wien\ChangedName - 3rdLevel\test.xlsm

FAILED Test Business SharePoint Library (3rd level mount) Library with changed UrlName<>Current (Local) Name (file exists)
URL path: https://tuwienacat.sharepoint.com/sites/InitialName/Freigegebene Dokumente/Test/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuido\TU Wien\ChangedName - Test\
act path: C:\Users\Witt-DörringGuido\TU Wien\ChangedName - Test (1)\test.xlsm

FAILED Test Business2 SharePoint Library added as Link (3rd level mount)
URL path: https://tuwienacat.sharepoint.com/sites/TestLib2/Freigegebene Dokumente/Level2/Level3/test.xlsm
Func ret: C:\Users\Witt-DörringGuido\OneDrive - TU Wien\Test - TestLinkLib\
act path: C:\Users\Witt-DörringGuido\OneDrive - TU Wien\Level3\test.xlsm

FAILED Business Account Personal Folder, Library as Link, linked folder same name as other folder in personal OneDrive
URL path: https://tuwienacat.sharepoint.com/sites/TestLib2/Freigegebene Dokumente/Test/Test/Test/test.xlsm
Func ret: C:\Users\Witt-DörringGuido\OneDrive - TU Wien\Test - TestLinkLib\
act path: C:\Users\Witt-DörringGuido\OneDrive - TU Wien\TestLinkParent\Test - TestLinkLib\Test\test.xlsm

While I haven't updated my testing system to properly deal with multiple correct result paths yet, this is not the problem here.

[cristianbuse]

Thanks @guwidoe ,

It seems I was too tired and my brain farted. I can't believe I was comparing the UrlNamespace instead of the fullURL. Just pushed again. Can you please re-test?

Thanks!

[guwidoe]

Hi @cristianbuse,

I ran the tests and it now returns correct local paths in all cases, but I don't think your function is behaving as you intended.

Let's look at this test case:

URL path: https://tuwienacat.sharepoint.com/sites/TestLib2/Freigegebene Dokumente/Test/Test/Test/test.xlsm

The Library is owned by Business2 The path your function returns is actually the sync by Business1:

Func ret: C:\Users\Witt-DörringGuido\TU Wien\TestLinkLib - Test\Test\test.xlsm

Business2 doesn't sync this library but only has it added as a link to its MySite folder, the path for which is

act path: C:\Users\Witt-DörringGuido\OneDrive - TU Wien\TestLinkParent\Test - TestLinkLib\Test\test.xlsm

If I understand your plans correctly you would have preferred the second path as a result.

[cristianbuse]

@guwidoe

Yes, you are correct. I only based my logic on the fact that the folder is synced but yeah it could be just a link. I think it becomes a bit more difficult to achieve this. I will think about it. Thanks!

[cristianbuse]

@guwidoe ,

Just pushed again. I added extra logic for the case you mentioned above. Can you please test? Thank you!

[guwidoe]

@cristianbuse

Just pushed again. I added extra logic for the case you mentioned above. Can you please test? Thank you!

I tested it again nothing seems to have changed about the behavior.

[cristianbuse]

Sincere apologies @guwidoe ,

I kept using the namespace for comparison instead of using the mount point. I just pushed again.

[guwidoe]

I kept using the namespace for comparison instead of using the mount point. I just pushed again.

It still behaves the same 😂 It's jinxed

[cristianbuse]

Hi @guwidoe ,

I have just pushed a new commit.

I decided that it's too rare that someone will encounter the edge cases we were discussing above (with multiple business accounts) and so, I eventually ended up adding a function that checks if a folder can be edited. My goal is to always return a folder that can be edited. I still check first if the providers are the 'main' provider or 'on main' which by default means that edit mode is already there but just as a last resort I still check if a folder can be edited and I simply return one of them.

Thanks for you help!

[guwidoe]

Hi @cristianbuse,

I'm finally back and able to test your code. Unfortunately, I can't say if it fulfills your requirements correctly, as I'm not testing for these. I can say, however, that it returns a correct path in every case, so it passes all my tests. I will update my function now to at least use some logic to deal with multiple result paths instead of just guessing and then post it to various threads on SO etc. so we can gather public feedback.

In my opinion, our solution is now satisfactory.

It's interesting how much we still unearthed in this issue and I think the most important fix apart from removing the error that occurred when multiple result paths existed was considering the moving of the link in the addedScope case.

[cristianbuse]

Thanks @guwidoe ,

Indeed, moving the link was a great idea. I'm glad we are now using the dat and ini files to find the correct folders as the registry has become quite useless for all these edge cases.

I also agree the solution is now satisfactory so I will close this issue.

Many thanks for your help!