If I want to use the open Workbook object to get the fullname of an Excel file after saving it, but that file has been synchronized to OneDrive, I get a "https" address instead of a local one, which other programs cannot interpret.
How do I get the local filename of a file like this?

Example:
Save a file to "C:\Users\user\OneDrive - Company\Documents".
OneDrive does its synchronization.
Querying Workbook.FullName now shows as "https://..."

Universal Solution & Meta-Analysis of All Solutions

TLDR:

• For the solution, skip to the section The Solutions

• For the meta-analysis, skip to the section Testing and comparison of solutions

Background

@Cristian Buse and I worked extensively on this problem after testing all other solutions available online and finding none of them universally accurate.

In the end, both of us created independent solutions:

• @Cristian Buse developed his solution as part of one of his excellent VBA Libraries, to be specific, the Library VBA-FileTools. This library also provides a bunch of other very useful functionalities.

• My own solution comes in the form of a standalone function without any dependencies. This is useful if this problem occurs in a small project where no additional functionality is required. Because implementing the desired universal functionality is complex, it is very long and convoluted for a single procedure.

---

The Solutions

NOTES:

• Should you encounter any bugs with our solutions, please report them here or on GitHub! In that case, I recommend you use this solution in the meantime, as it is the next most accurate solution available.

Solution 1 - Library

Import this library: VBA-FileTools from GitHub into your project. Getting the local name of your workbook is then as easy as:

GetLocalPath(ThisWorkbook.FullName)

^{Notes:
Full Mac support was added to this solution on Apr 5, 2023.
Support for OneDrive version 23.184.0903.0001 was added to this solution on Sep 25, 2023.}

Solution 2 - Standalone Function

Copy this function, from GitHub Gist into any standard code module.

Getting the local name of your workbook now works in the same way as with Solution 1:

GetLocalPath(ThisWorkbook.FullName)

^{Notes:
Partial Mac support was added to this solution on Dec 20, 2022, and full support on Mar 20, 2023.
Support for OneDrive version 23.184.0903.0001 was added to this solution on Oct 2, 2023.
This function also offers some optional parameters, but they should almost never be needed. (See Gist for more information)}

You can also copy the function directly from here: ^{Shortened because of StackOverflows 30 000 character answer length limit.}

'Function for converting a OneDrive URL to the corresponding local path
'Algorithmically shortened code from here: 
'https://gist.github.com/guwidoe/038398b6be1b16c458365716a921814d
'Author: Guido Witt-Dörring
Public Function GetLocalPath$(ByVal path$, Optional ByVal returnAll As Boolean = False, Optional ByVal preferredMountPointOwner$ = "", Optional ByVal rebuildCache As Boolean = False)
#If Mac Then
Const dp& = 70
Const ch$ = ".849C9593-D756-4E56-8D6E-42412F2A707B"
Const er As Boolean = True
Const ab$ = "/"
#Else
Const ab$ = "\"
Const er As Boolean = False
#End If
Const be$ = "GetLocalPath"
Const es& = 53
Const fl& = 7
Const fm& = 457
Const fn& = 325
Static ac As collection, et As Date
If Not Left(path, 8) = "https://" Then GetLocalPath = path: Exit Function
Dim r$, h$, b$, e
Dim dq$: dq = LCase$(preferredMountPointOwner)
If Not ac Is Nothing And Not rebuildCache Then
Dim bn As collection: Set bn = New collection
For Each e In ac
h = e(0): r = e(1)
If InStr(1, path, r, vbTextCompare) = 1 Then bn.Add Key:=e(2), Item:=Replace(Replace(path, r, h, , 1), "/", ab)
Next e
If bn.count > 0 Then
If returnAll Then
For Each e In bn: b = b & "//" & e: Next e
GetLocalPath = Mid$(b, 3): Exit Function
End If
On Error Resume Next: GetLocalPath = bn(dq): On Error GoTo 0
If GetLocalPath <> "" Then Exit Function
GetLocalPath = bn(1): Exit Function
End If
GetLocalPath = path
End If
Dim bg As collection: Set bg = New collection
Dim ax, ds$
#If Mac Then
Dim ci$, dt As Boolean
b = Environ("HOME")
ds = b & "/Library/Application Support/Microsoft/Office/CLP/"
b = Left$(b, InStrRev(b, "/Library/Containers/", , vbBinaryCompare))
bg.Add b & "Library/Containers/com.microsoft.OneDrive-mac/Data/Library/Application Support/OneDrive/settings/"
bg.Add b & "Library/Application Support/OneDrive/settings/"
ci = b & "Library/CloudStorage/"
#Else
bg.Add Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\"
ds = Environ("LOCALAPPDATA") & "\Microsoft\Office\CLP\"
#End If
Dim a&
#If Mac Then
Dim ay(): ReDim ay(1 To bg.count * 11 + 1)
For Each ax In bg
For a = a + 1 To a + 9
ay(a) = ax & "Business" & a Mod 11
Next a
ay(a) = ax: a = a + 1
ay(a) = ax & "Personal"
Next ax
ay(a + 1) = ci
Dim du As Boolean
du = getsetting("GetLocalPath", "AccessRequestInfoMsg", "Displayed", "False") = "True"
If Not du Then MsgBox "The current VBA Project requires access to the OneDrive settings files to translate a OneDrive URL to the local path of the locally synchronized file/folder on your Mac. Because these files are located outside of Excels sandbox, file-access must be granted explicitly. Please approve the access requests following this message.", vbInformation
If Not GrantAccessToMultipleFiles(ay) Then Err.Raise dp, be
#End If
Dim cz As collection: Set cz = New collection
For Each ax In bg
Dim g$: g = Dir(ax, vbDirectory)
Do Until g = vbNullString
If g = "Personal" Or g Like "Business#" Then cz.Add Item:=ax & g & ab
g = Dir(, vbDirectory)
Loop
Next ax
If Not ac Is Nothing Or er Then
Dim bf As collection: Set bf = New collection
Dim f
For Each f In cz
Dim t$: t = iif(f Like "*" & ab & "Personal" & ab, "????????????*", "????????-????-????-????-????????????")
Dim p$: p = Dir(f, vbNormal)
Do Until p = vbNullString
If p Like t & ".ini" Or p Like t & ".dat" Or p Like "ClientPolicy*.ini" Or StrComp(p, "GroupFolders.ini", vbTextCompare) = 0 Or StrComp(p, "global.ini", vbTextCompare) = 0 Or StrComp(p, "SyncEngineDatabase.db", vbTextCompare) = 0 Then bf.Add Item:=f & p
p = Dir
Loop
Next f
End If
If Not ac Is Nothing And Not rebuildCache Then
Dim at
For Each at In bf
If FileDateTime(at) > et Then rebuildCache = True: Exit For
Next at
If Not rebuildCache Then Exit Function
End If
Dim c&, am$, d() As Byte, i&, q&
Dim bp&, au() As Byte, ck$
Dim l() As Byte, ao$, aj() As Byte
Dim az() As Byte, bq$, av&
Dim y&, dx&, dy&
et = Now()
#If Mac Then
Dim z As collection: Set z = New collection
g = Dir(ci, vbDirectory)
Do Until g = vbNullString
If g Like "OneDrive*" Then
dt = True
f = ci & g & ab
at = ci & g & ab & ch
z.Add Item:=f
bf.Add Item:=f
bf.Add Item:=at
End If
g = Dir(, vbDirectory)
Loop
If ac Is Nothing Then
Dim da
If bf.count > 0 Then
ReDim da(1 To bf.count)
For a = 1 To UBound(da): da(a) = bf(a): Next a
If Not GrantAccessToMultipleFiles(da) Then Err.Raise dp, be
End If
End If
If dt Then
For a = z.count To 1 Step -1
Dim br&: br = 0
On Error Resume Next
br = GetAttr(z(a) & ch)
Dim bs As Boolean: bs = False
If Err.Number = 0 Then bs = Not CBool(br And vbDirectory)
On Error GoTo 0
If Not bs Then
g = Dir(z(a), vbDirectory)
Do Until g = vbNullString
If Not g Like ".Trash*" And g <> "Icon" Then
z.Add z(a) & g & ab
z.Add z(a) & g & ab & ch, z(a) & g & ab
End If
g = Dir(, vbDirectory)
Loop
z.Remove a
End If
Next a
If z.count > 0 Then
ReDim ay(1 To z.count)
For a = 1 To z.count: ay(a) = z(a): Next a
If Not GrantAccessToMultipleFiles(ay) Then Err.Raise dp, be
End If
On Error Resume Next
For a = z.count To 1 Step -1
z.Remove z(a)
Next a
On Error GoTo 0
Dim dz As collection
Set dz = New collection
For Each f In z
br = 0
On Error Resume Next
br = GetAttr(f & ch)
bs = False
If Err.Number = 0 Then bs = Not CBool(br And vbDirectory)
On Error GoTo 0
If bs Then
c = FreeFile(): b = "": at = f & ch
Dim ea As Boolean: ea = False
On Error GoTo ReadFailed
Open at For Binary Access Read As #c
ReDim d(0 To LOF(c)): Get c, , d: b = d
ea = True
ReadFailed: On Error GoTo -1
Close #c: c = 0
On Error GoTo 0
If ea Then
au = b
If LenB(b) > 0 Then
ReDim l(0 To LenB(b) * 2 - 1): q = 0
For i = LBound(au) To UBound(au)
l(q) = au(i): q = q + 2
Next i
b = l
Else: b = vbNullString
End If
Else
at = MacScript("return path to startup disk as string") & Replace(Mid$(at, 2), ab, ":")
b = MacScript("return read file """ & at & """ as string")
End If
If InStr(1, b, """guid"" : """, vbBinaryCompare) Then
b = Split(b, """guid"" : """)(1)
am = Left$(b, InStr(1, b, """", 0) - 1)
dz.Add Key:=am, Item:=VBA.Array(am, Left$(f, Len(f) - 1))
Else
Debug.Print "Warning, empty syncIDFile encountered!"
End If
End If
Next f
End If
If Not du Then savesetting "GetLocalPath", "AccessRequestInfoMsg", "Displayed", "True"
#End If
Dim j, w$(), s&, cl$
Dim db$, dc$, cm$, bj$
Dim aa$, ak$, aq$
Dim bx$, ew$, by As Boolean
Dim bz$, ca$, dd$, ex$
Dim ey$, af$, ez$
Dim fa$: fa = chrb$(2)
Dim eb As String * 4: MidB$(eb, 1) = chrb$(1)
Dim ec$: ec = chrb$(0)
#If Mac Then
Const ed$ = vbNullChar & vbNullChar
#Else
Const ed$ = vbNullChar
#End If
Dim cn As collection, fd As Date
Set cn = New collection
Set ac = New collection
For Each f In cz
g = Mid$(f, InStrRev(f, ab, Len(f) - 1, 0) + 1)
g = Left$(g, Len(g) - 1)
If Dir(f & "global.ini", vbNormal) = "" Then GoTo NextFolder
c = FreeFile()
Open f & "global.ini" For Binary Access Read As #c
ReDim d(0 To LOF(c)): Get c, , d
Close #c: c = 0
#If Mac Then
bq = d: GoSub DecodeUTF8
d = ao
#End If
For Each j In Split(d, vbNewLine)
If j Like "cid = *" Then t = Mid$(j, 7): Exit For
Next j
If t = vbNullString Then GoTo NextFolder
If (Dir(f & t & ".ini") = vbNullString Or (Dir(f & "SyncEngineDatabase.db") = vbNullString And Dir(f & t & ".dat") = vbNullString)) Then GoTo NextFolder
If g Like "Business#" Then
bx = Replace(Space$(32), " ", "[a-f0-9]") & "*"
ElseIf g = "Personal" Then
bx = Replace(Space$(12), " ", "[A-F0-9]") & "*!###*"
End If
p = Dir(ds, vbNormal)
Do Until p = vbNullString
a = InStrRev(p, t, , vbTextCompare)
If a > 1 And t <> vbNullString Then bj = LCase$(Left$(p, a - 2)): Exit Do
p = Dir
Loop
#If Mac Then
On Error Resume Next
fd = cn(g)
by = (Err.Number = 0)
On Error GoTo 0
If by Then
If FileDateTime(f & t & ".ini") < fd Then
GoTo NextFolder
Else
For a = ac.count To 1 Step -1
If ac(a)(5) = g Then
ac.Remove a
End If
Next a
cn.Remove g
cn.Add Key:=g, Item:=FileDateTime(f & t & ".ini")
End If
Else
cn.Add Key:=g, Item:=FileDateTime(f & t & ".ini")
End If
#End If
Dim ba As collection: Set ba = New collection
p = Dir(f, vbNormal)
Do Until p = vbNullString
If p Like "ClientPolicy*.ini" Then
c = FreeFile()
Open f & p For Binary Access Read As #c
ReDim d(0 To LOF(c)): Get c, , d
Close #c: c = 0
#If Mac Then
bq = d: GoSub DecodeUTF8
d = ao
#End If
ba.Add Key:=p, Item:=New collection
For Each j In Split(d, vbNewLine)
If InStr(1, j, " = ", vbBinaryCompare) Then
db = Left$(j, InStr(1, j, " = ", 0) - 1)
b = Mid$(j, InStr(1, j, " = ", 0) + 3)
Select Case db
Case "DavUrlNamespace"
ba(p).Add Key:=db, Item:=b
Case "SiteID", "IrmLibraryId", "WebID"
b = Replace(LCase$(b), "-", "")
If Len(b) > 3 Then b = Mid$(b, 2, Len(b) - 2)
ba(p).Add Key:=db, Item:=b
End Select
End If
Next j
End If
p = Dir
Loop
Dim x As collection: Set x = Nothing
If Dir(f & t & ".dat") = vbNullString Then GoTo Continue
Const fs& = 1000
Const cp& = 255
Dim bb&: bb = -1
Try: On Error GoTo Catch
Set x = New collection
Dim cq&: cq = 1
Dim cr As Date: cr = FileDateTime(f & t & ".dat")
a = 0
Do
If FileDateTime(f & t & ".dat") > cr Then GoTo Try
c = FreeFile
Open f & t & ".dat" For Binary Access Read As #c
Dim df&: df = LOF(c)
If bb = -1 Then bb = df
ReDim d(0 To bb + fs)
Get c, cq, d: b = d
Dim cs&: cs = LenB(b)
Close #c: c = 0
cq = cq + bb
For e = 16 To 8 Step -8
a = InStrB(e + 1, b, eb, 0)
Do While a > e And a < cs - 168
If StrComp(MidB$(b, a - e, 1), fa, 0) = 0 Then
a = a + 8: s = InStrB(a, b, ec, 0) - a
If s < 0 Then s = 0
If s > 39 Then s = 39
#If Mac Then
ck = MidB$(b, a, s)
GoSub DecodeANSI: ak = ao
#Else
ak = StrConv(MidB$(b, a, s), vbUnicode)
#End If
a = a + 39: s = InStrB(a, b, ec, 0) - a
If s < 0 Then s = 0
If s > 39 Then s = 39
#If Mac Then
ck = MidB$(b, a, s)
GoSub DecodeANSI: aa = ao
#Else
aa = StrConv(MidB$(b, a, s), vbUnicode)
#End If
a = a + 121
s = InStr(-Int(-(a - 1) / 2) + 1, b, ed, 0) * 2 - a - 1
If s > cp * 2 Then s = cp * 2
If s < 0 Then s = 0
If ak Like bx And aa Like bx Then
#If Mac Then
Do While s Mod 4 > 0
If s > cp * 4 Then Exit Do
s = InStr(-Int(-(a + s) / 2) + 1, b, ed, 0) * 2 - a - 1
Loop
If s > cp * 4 Then s = cp * 4
aj = MidB$(b, a, s)
ReDim l(LBound(aj) To UBound(aj))
i = LBound(aj): q = LBound(aj)
Do While i < UBound(aj)
If aj(i + 2) + aj(i + 3) = 0 Then
l(q) = aj(i)
l(q + 1) = aj(i + 1)
q = q + 2
Else
If aj(i + 3) <> 0 Then Err.Raise fn, be
y = aj(i + 2) * &H10000 + aj(i + 1) * &H100& + aj(i)
bp = y - &H10000
dy = &HD800& Or (bp \ &H400&)
dx = &HDC00& Or (bp And &H3FF)
l(q) = dy And &HFF&
l(q + 1) = dy \ &H100&
l(q + 2) = dx And &HFF&
l(q + 3) = dx \ &H100&
q = q + 4
End If
i = i + 4
Loop
If q > LBound(l) Then
ReDim Preserve l(LBound(l) To q - 1)
aq = l
Else: aq = vbNullString
End If
#Else
aq = MidB$(b, a, s)
#End If
x.Add VBA.Array(aa, aq), ak
End If
End If
a = InStrB(a + 1, b, eb, 0)
Loop
If x.count > 0 Then Exit For
Next e
Loop Until cq >= df Or bb >= df
GoTo Continue
Catch:
Select Case Err.Number
Case fm
x.Remove ak
Resume
Case Is <> fl: Err.Raise Err, be
End Select
If bb > &HFFFFF Then bb = bb / 2: Resume Try
Err.Raise Err, be
Continue:
On Error GoTo 0
If Not x Is Nothing Then GoTo SkipDbFile
c = FreeFile()
Open f & "SyncEngineDatabase.db" For Binary Access Read As #c
cs = LOF(c)
If cs = 0 Then GoTo CloseFile
Dim ee$: ee = chrw$(&H808)
Const fx& = 8
Const fy& = -3
Const fg As Byte = 9
Const fh& = 6
Const fz& = &H16
Const ga& = &H15
Const cc& = -16
Const dj& = -15
Const ef& = &H100000
Dim bk&, cd&, bc&
Dim ag(1 To 4) As Byte
Dim an$, dk$
Dim eg&
Dim eh&
Dim ei&, dl&
Dim ej As Byte, ek As Byte
Dim el As Boolean
cr = 0
ReDim d(1 To ef)
Do
a = 0
If FileDateTime(f & "SyncEngineDatabase.db") > cr Then
Set x = New collection
Dim dm As collection: Set dm = New collection
cr = FileDateTime(f & "SyncEngineDatabase.db")
bk = 1
an = vbNullString
End If
If LenB(an) > 0 Then
aq = MidB$(b, eg, eh)
End If
Get c, bk, d
b = d
a = InStrB(1 - cc, b, ee, vbBinaryCompare)
dl = 0
Do While a > 0
If a + cc - 2 > dl And LenB(an) > 0 Then
If dl > 0 Then
aq = MidB$(b, eg, eh)
End If
bq = aq: GoSub DecodeUTF8
aq = ao
On Error Resume Next
x.Add VBA.Array(dk, aq), an
If Err.Number <> 0 Then
If dm(an) < ek Then
If x(an)(1) <> aq Or x(an)(0) <> dk Then
x.Remove an
dm.Remove an
x.Add VBA.Array(dk, aq), an
End If
End If
End If
dm.Add ek, an
On Error GoTo 0
an = vbNullString
End If
If d(a + fy) <> fx Then GoTo NextSig
el = True
If d(a + dj) = ga Then
i = a + dj
ElseIf d(a + cc) = fz Then
i = a + cc
el = False
ElseIf d(a + dj) <= fg Then
i = a + dj
Else
GoTo NextSig
End If
ej = d(i)
cd = fh
For q = 1 To 4
If q = 1 And ej <= fg Then
ag(q) = d(i + 2)
Else
ag(q) = d(i + q)
End If
If ag(q) < 37 Or ag(q) Mod 2 = 0 Then GoTo NextSig
ag(q) = (ag(q) - 13) / 2
cd = cd + ag(q)
Next q
If el Then
bc = d(i + 5)
If bc < 15 Or bc Mod 2 = 0 Then GoTo NextSig
bc = (bc - 13) / 2
Else
bc = (d(i + 5) - 128) * 64 + (d(i + 6) - 13) / 2
If bc < 1 Or d(i + 6) Mod 2 = 0 Then GoTo NextSig
End If
cd = cd + bc
ei = a + cd - 1
If ei > ef Then
a = a - 1
Exit Do
End If
i = a + fh
#If Mac Then
ck = MidB$(b, i, ag(1))
GoSub DecodeANSI: ak = ao
#Else
ak = StrConv(MidB$(b, i, ag(1)), vbUnicode)
#End If
i = i + ag(1)
aa = StrConv(MidB$(b, i, ag(2)), vbUnicode)
#If Mac Then
ck = MidB$(b, i, ag(2))
GoSub DecodeANSI: aa = ao
#Else
aa = StrConv(MidB$(b, i, ag(2)), vbUnicode)
#End If
If ak Like bx And aa Like bx Then
eg = i + ag(2) + ag(3) + ag(4)
eh = bc
an = Left(ak, 32)
dk = Left(aa, 32)
ek = ej
dl = ei
End If
NextSig:
a = InStrB(a + 1, b, ee, vbBinaryCompare)
Loop
If a = 0 Then
bk = bk + ef + cc
Else
bk = bk + a + cc
End If
Loop Until bk > cs
CloseFile:
Close #c
SkipDbFile:
c = FreeFile()
Open f & t & ".ini" For Binary Access Read As #c
ReDim d(0 To LOF(c)): Get c, , d
Close #c: c = 0
#If Mac Then
bq = d: GoSub DecodeUTF8:
d = ao
#End If
Select Case True
Case g Like "Business#"
Dim em As collection: Set em = New collection
dc = vbNullString
For Each j In Split(d, vbNewLine)
r = "": h = "": w = Split(j, """")
Select Case Left$(j, InStr(1, j, " = ", 0) - 1)
Case "libraryScope"
h = w(9)
af = h: am = Split(w(10), " ")(2)
cl = Split(j, " ")(2)
ew = w(3): w = Split(w(8), " ")
bz = w(1): dd = w(2): ca = w(3)
If dc = vbNullString And ew = "ODB" Then
dc = h: p = "ClientPolicy.ini"
ey = am: ez = af
Else: p = "ClientPolicy_" & ca & bz & ".ini"
End If
On Error Resume Next
r = ba(p)("DavUrlNamespace")
On Error GoTo 0
If r = "" Then
For Each e In ba
If e("SiteID") = bz And e("WebID") = dd And e("IrmLibraryId") = ca Then
r = e("DavUrlNamespace"): Exit For
End If
Next e
End If
If r = vbNullString Then Err.Raise es, be
em.Add VBA.Array(cl, r), cl
If Not h = vbNullString Then ac.Add VBA.Array(h, r, bj, am, af, g), Key:=h
Case "libraryFolder"
cl = Split(j, " ")(3)
h = w(1): af = h
am = Split(w(4), " ")(1)
b = vbNullString: aa = Left$(Split(j, " ")(4), 32)
Do
On Error Resume Next: x aa
by = (Err.Number = 0): On Error GoTo 0
If Not by Then Exit Do
b = x(aa)(1) & "/" & b
aa = x(aa)(0)
Loop
r = em(cl)(1) & b
ac.Add VBA.Array(h, r, bj, am, af, g), h
Case "AddedScope"
cm = w(5): If cm = " " Then cm = ""
w = Split(w(4), " "): bz = w(1)
dd = w(2): ca = w(3): ex = w(4)
p = "ClientPolicy_" & ca & bz & ex & ".ini"
On Error Resume Next
r = ba(p)("DavUrlNamespace") & cm
On Error GoTo 0
If r = "" Then
For Each e In ba
If e("SiteID") = bz And e("WebID") = dd And e("IrmLibraryId") = ca Then
r = e("DavUrlNamespace") & cm
Exit For
End If
Next e
End If
If r = vbNullString Then Err.Raise es, be
b = vbNullString: aa = Left$(Split(j, " ")(3), 32)
Do
On Error Resume Next: x aa
by = (Err.Number = 0): On Error GoTo 0
If Not by Then Exit Do
b = x(aa)(1) & ab & b
aa = x(aa)(0)
Loop
h = dc & ab & b
ac.Add VBA.Array(h, r, bj, ey, ez, g), h
Case Else: Exit For
End Select
Next j
Case g = "Personal"
For Each j In Split(d, vbNewLine)
If j Like "library = *" Then
w = Split(j, """"): h = w(3)
af = h: am = Split(w(4), " ")(2)
Exit For
End If
Next j
On Error Resume Next
r = ba("ClientPolicy.ini")("DavUrlNamespace")
On Error GoTo 0
If h = "" Or r = "" Or t = "" Then GoTo NextFolder
ac.Add VBA.Array(h, r & "/" & t, bj, am, af, g), Key:=h
If Dir(f & "GroupFolders.ini") = "" Then GoTo NextFolder
t = vbNullString: c = FreeFile()
Open f & "GroupFolders.ini" For Binary Access Read As #c
ReDim d(0 To LOF(c)): Get c, , d
Close #c: c = 0
#If Mac Then
bq = d: GoSub DecodeUTF8
d = ao
#End If
For Each j In Split(d, vbNewLine)
If j Like "*_BaseUri = *" And t = vbNullString Then
t = LCase$(Mid$(j, InStrRev(j, "/", , 0) + 1, InStrRev(j, "!", , 0) - InStrRev(j, "/", , 0) - 1))
ak = Left$(j, InStr(1, j, "_", 0) - 1)
ElseIf t <> vbNullString Then
ac.Add VBA.Array(h & ab & x(ak)(1), r & "/" & t & "/" & Mid$(j, Len(ak) + 9), bj, am, af, g), Key:=h & ab & x(ak)(1)
t = vbNullString: ak = vbNullString
End If
Next j
End Select
NextFolder:
t = vbNullString: b = vbNullString: bj = vbNullString
Next f
Dim ce As collection: Set ce = New collection
For Each e In ac
h = e(0): r = e(1): af = e(4)
If Right$(r, 1) = "/" Then r = Left$(r, Len(r) - 1)
If Right$(h, 1) = ab Then h = Left$(h, Len(h) - 1)
If Right$(af, 1) = ab Then af = Left$(af, Len(af) - 1)
ce.Add VBA.Array(h, r, e(2), e(3), af), h
Next e
Set ac = ce
#If Mac Then
If dt Then
Set ce = New collection
For Each e In ac
h = e(0): am = e(3): af = e(4)
h = Replace(h, af, dz(am)(1), , 1)
ce.Add VBA.Array(h, e(1), e(2)), h
Next e
Set ac = ce
End If
#End If
GetLocalPath = GetLocalPath(path, returnAll, dq, False): Exit Function
Exit Function
DecodeUTF8:
Const cf As Boolean = False
Dim u&, m&, bl&
Static cg(0 To 255) As Byte
Static fj&(2 To 4)
Static dn&(2 To 4)
If cg(0) = 0 Then
For u = &H0& To &H7F&: cg(u) = 1: Next u
For u = &HC2& To &HDF&: cg(u) = 2: Next u
For u = &HE0& To &HEF&: cg(u) = 3: Next u
For u = &HF0& To &HF4&: cg(u) = 4: Next u
For u = 2 To 4: fj(u) = (2 ^ (7 - u) - 1): Next u
dn(2) = &H80&: dn(3) = &H800&: dn(4) = &H10000
End If
Dim en As Byte
az = bq
ReDim l(0 To (UBound(az) - LBound(az) + 1) * 2)
m = 0
u = LBound(az)
Do While u <= UBound(az)
y = az(u)
av = cg(y)
If av = 0 Then
If cf Then Err.Raise 5
GoTo insertErrChar
ElseIf av = 1 Then
l(m) = y
m = m + 2
ElseIf u + av - 1 > UBound(az) Then
If cf Then Err.Raise 5
GoTo insertErrChar
Else
y = az(u) And fj(av)
For bl = 1 To av - 1
en = az(u + bl)
If (en And &HC0&) = &H80& Then
y = (y * &H40&) + (en And &H3F)
Else
If cf Then Err.Raise 5
GoTo insertErrChar
End If
Next bl
If y < dn(av) Then
If cf Then Err.Raise 5
GoTo insertErrChar
ElseIf y < &HD800& Then
l(m) = CByte(y And &HFF&)
l(m + 1) = CByte(y \ &H100&)
m = m + 2
ElseIf y < &HE000& Then
If cf Then Err.Raise 5
GoTo insertErrChar
ElseIf y < &H10000 Then
If y = &HFEFF& Then GoTo nextCp
l(m) = y And &HFF&
l(m + 1) = y \ &H100&
m = m + 2
ElseIf y < &H110000 Then
bp = y - &H10000
Dim eo&: eo = &HDC00& Or (bp And &H3FF)
Dim ep&: ep = &HD800& Or (bp \ &H400&)
l(m) = ep And &HFF&
l(m + 1) = ep \ &H100&
l(m + 2) = eo And &HFF&
l(m + 3) = eo \ &H100&
m = m + 4
Else
If cf Then Err.Raise 5
insertErrChar: l(m) = &HFD
l(m + 1) = &HFF
m = m + 2
If av = 0 Then av = 1
End If
End If
nextCp: u = u + av
Loop
ao = MidB$(l, 1, m)
Return
DecodeANSI:
au = ck
m = UBound(au) - LBound(au) + 1
If m > 0 Then
ReDim l(0 To m * 2 - 1): bl = 0
For m = LBound(au) To UBound(au)
l(bl) = au(m): bl = bl + 2
Next m
ao = l
Else
ao = vbNullString
End If
Return
End Function

---

How Do the Solutions Work?

Both solutions get all of the required information for translating the OneDrive URL to a local path from the OneDrive settings files inside of the directory %localappdata%\Microsoft\OneDrive\settings\....

The following files may be read:

(Wildcards: * - zero or more characters; ? - one character)

????????????????.dat
????????????????.ini
global.ini
GroupFolders.ini
????????-????-????-????-????????????.dat
????????-????-????-????-????????????.ini
ClientPolicy*.ini
SyncEngineDatabase.db

Data from all of these files is used, to create a "dictionary" of all the local mount points on your pc, and their corresponding OneDrive URL-root. For example, for your personal OneDrive, such a local mount point could look like this: C:\Users\Username\OneDrive, and the corresponding URL-root could look like this: https://d.docs.live.net/f9d8c1184686d493.

For more information on how exactly the dictionary is built and used, please refer to the extensive comments above the code in the Gist of the standalone function and the resources linked there.

---

Testing and Comparison of Solutions

I conducted extensive testing of all solutions I could find online. A selection of these tests will be presented here.

This is a list of some of the tested solutions:

Each line in the table in the below image represents one solution in the above table and they can be correlated using the solution number.
Likewise, each column represents a test case, they can be correlated to this test-table by using the test-number. Unfortunately, Stack Overflow doesn't allow answers long enough to include the table of test cases directly in this post.

^{All of this testing was done on Windows. On macOS, every solution except for Nr 32 and Nr 33 would pass 0/46 tests. The solutions presented in this post (#32 and #33) also pass every test on macOS.}

Most solutions pass very few tests. Many of these tests are relatively difficult to solve, some are absolute edge cases, such as tests Nr 41 to 46, that test how a solution deals with OneDrive folders that are synced to multiple different local paths, which can only happen if multiple Business OneDrive accounts are logged in on the same PC and even then needs some special setup. (More information on that can be found here in Thread 2)

Test Nr 22 contains various Unicode emoji characters in some folder names, this is why many solutions fail with error here.

If you have another different solution you would like me to test, let me know and I'll add it to this section.