About the getFullLocalPath function

[hanamichi77777]

As shown in the code below, when I run getFullLocalPath(ThisWorkbook.Path) in the root directory of OneDrive, I cannot get the local path.However, if I run it outside the root directory, it works fine.
I want to check if it depends on the environment.

Sub Sample()

Dim strPath As String
strPath = getFullLocalPath(ThisWorkbook.Path) & "\test"
If Dir(strPath, vbDirectory) = "" Then MkDir strPath

End Sub

[hanamichi77777]

An amendment has been created.
What do you think?

Private Function getLocalOneDrivePath(ByVal targetPath As String) As String
    'for more info, see https://stackoverflow.com/a/72736800/11738627 post by Guido Witt-Dorring
    'this function returns the original/local disk path associated with a synched OneDrive or SharePoint cloud url
    'this function assumes that the specified path exists
    Dim origPath As String: origPath = targetPath '(@6DiegoDiego9)

    Const HKCU = &H80000001
    Dim objReg As Object, rPath As String, subKeys() As Variant, subKey As Variant
    Dim urlNamespace As String, mountPoint As String, secPart As String
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\." & "\root\default:StdRegProv")
    rPath = "Software\SyncEngines\Providers\OneDrive\"
    objReg.EnumKey HKCU, rPath, subKeys
    For Each subKey In subKeys
        objReg.GetStringValue HKCU, rPath & subKey, "UrlNamespace", urlNamespace
        If InStr(targetPath, urlNamespace) > 0 Then
            objReg.GetStringValue HKCU, rPath & subKey, "MountPoint", mountPoint
            secPart = Replace$(Mid$(targetPath, Len(urlNamespace) + 1), "/", "\") '+1
            Dim firstSecPart As String: firstSecPart = secPart
            targetPath = mountPoint & secPart
            Do Until Dir(targetPath, vbDirectory) <> "" Or InStr(2, secPart, "\") = 0
                secPart = Mid$(secPart, InStr(2, secPart, "\"))
                targetPath = mountPoint & secPart
            Loop
            Exit For
        End If
    Next subKey
    If firstSecPart = secPart Then targetPath = mountPoint 'root directory
    
    Dim fso As New FileSystemObject
    If Not (fso.FileExists(targetPath) Or fso.FolderExists(targetPath)) Then
        targetPath = origPath 'fallback to original path if it's online-only (excluded from sync) (@6DiegoDiego9)
    End If
    getLocalOneDrivePath = targetPath
End Function

[GCuser99]

Thanks for reporting this. Hopefully @6DiegoDiego9 will have a chance to test your proposed solution as I am not using OneDrive.

In the meantime, can you provide some clarity in your code above? I can't see where the variable firstSecPart is defined...

Mike

[hanamichi77777]

Thank you.
I added it to the code because it was a declaration of firstSecPart.

In the meantime, can you provide some clarity in your code above? I can't see where the variable firstSecPart is defined...

[hanamichi77777]

There is a similar proposal in the pull request, so I will close this one.
Thank you.

[6DiegoDiego9]

Thanks @hanamichi77777

I made some basic tests, supporting your fix (see the 4rd).

---

Original function:

?webshared.getLocalOneDrivePath("https://d.docs.live.net/E06AC432B5CC3845/Documenti/")
C:\Users\diego\OneDrive\Documenti\

?webshared.getLocalOneDrivePath("https://d.docs.live.net/E06AC432B5CC3845/Documenti")
C:\Users\diego\OneDrive\Documenti

?webshared.getLocalOneDrivePath("https://d.docs.live.net/E06AC432B5CC3845/")
C:\Users\diego\OneDrive\

?webshared.getLocalOneDrivePath("https://d.docs.live.net/E06AC432B5CC3845")
https://d.docs.live.net/E06AC432B5CC3845

---

@hanamichi77777's version:

?webshared.getLocalOneDrivePath("https://d.docs.live.net/E06AC432B5CC3845/Documenti/")
C:\Users\diego\OneDrive\Documenti\

?webshared.getLocalOneDrivePath("https://d.docs.live.net/E06AC432B5CC3845/Documenti")
C:\Users\diego\OneDrive\Documenti

?webshared.getLocalOneDrivePath("https://d.docs.live.net/E06AC432B5CC3845/")
C:\Users\diego\OneDrive\

?webshared.getLocalOneDrivePath("https://d.docs.live.net/E06AC432B5CC3845")
C:\Users\diego\OneDrive

---

I applied your fix.

[hanamichi77777]

Thank you.
I am not confident about the contents of the revision code, so please use @conan-hdk's suggestion.