Excel's fullname property with OneDrive - excel

Question

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://..."

Answer 1

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
In the last few months, #Cristian Buse (GitHub) and I performed extensive research and work on the problem in question, which led to the discovery of a large number of cases no previously available solution could solve. Because of this, we started refining our own solutions.
Unfortunately, throughout development, our solutions grew very complex. Describing how exactly they work would go far beyond the scope of a single StackOverflow answer.
For those who are interested in these technicalities, here are links to the threads we used to discuss our progress: Thread 1, Thread 2. The total volume of these threads is approximately 40,000 words or 150 pages. Luckily, it is not necessary to understand any of that to harvest the fruits of our efforts.
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. It is implemented elegantly and stepping through his code is the best way of comprehending how the solution works in detail. Furthermore, his library 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. I do not recommend trying to comprehend the solution by reading the code of this function.
As of now (27th Jan. 2023), this is the only solution for this problem that also works on macOS!
The Solutions
NOTE: 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 (currently Windows only)
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)
Solution 2 - Standalone Function (works on Windows and macOS)
Copy this function, either from GitHub Gist or from this answer directly, into any standard code module. The version on GitHub Gist includes more information and some comments in and on the code.
Getting the local name of your workbook now works in the same way as with Solution 1:
GetLocalPath(ThisWorkbook.FullName)
Note that this function also offers some optional parameters, but they should almost never be needed. (See Gist for more information)
If you are using MacOS, this is currently the only solution for you. Every other solution analyzed in this post will not work at all on macOS!
Here is the code of the function:
'This Function will convert a OneDrive/SharePoint Url path, e.g. Url containing
'https://d.docs.live.net/; .sharepoint.com/sites; my.sharepoint.com/personal/...
'to the locally synchronized path on your current pc or mac, e.g. a path like
'C:\users\username\OneDrive\ on Windows; or /Users/username/OneDrive/ on MacOS,
'if you have the remote directory locally synchronized with the OneDrive app.
'If no local path can be found, the input value will be returned unmodified.
'Author: Guido Witt-Dörring
'Source: https://gist.github.com/guwidoe/038398b6be1b16c458365716a921814d
Public Function GetLocalPath(ByVal path As String, _
Optional ByVal rebuildCache As Boolean = False, _
Optional ByVal returnAll As Boolean = False, _
Optional ByVal preferredMountPointOwner As String = "") _
As String
#If Mac Then
Const vbErrPermissionDenied As Long = 70
Const vbErrInvalidFormatInResourceFile As Long = 325
Const ps As String = "/"
#Else
Const ps As String = "\"
#End If
Const vbErrFileNotFound As Long = 53
Static locToWebColl As Collection, lastTimeNotFound As Collection
Static lastCacheUpdate As Date
Dim resColl As Object, webRoot As String, locRoot As String
Dim vItem As Variant, s As String, keyExists As Boolean
Dim pmpo As String: pmpo = LCase(preferredMountPointOwner)
If Not locToWebColl Is Nothing And Not rebuildCache Then
Set resColl = New Collection: GetLocalPath = ""
For Each vItem In locToWebColl
locRoot = vItem(0): webRoot = vItem(1)
If InStr(1, path, webRoot, vbTextCompare) = 1 Then _
resColl.Add Key:=vItem(2), _
Item:=Replace(Replace(path, webRoot, locRoot, , 1), "/", ps)
Next vItem
If resColl.Count > 0 Then
If returnAll Then
For Each vItem In resColl: s = s & "//" & vItem: Next vItem
GetLocalPath = Mid(s, 3): Exit Function
End If
On Error Resume Next: GetLocalPath = resColl(pmpo): On Error GoTo 0
If GetLocalPath <> "" Then Exit Function
GetLocalPath = resColl(1): Exit Function
End If
If Not lastTimeNotFound Is Nothing Then
On Error Resume Next: lastTimeNotFound path
keyExists = (Err.Number = 0): On Error GoTo 0
If keyExists Then
If DateAdd("s", 1, lastTimeNotFound(path)) > Now() Then _
GetLocalPath = path: Exit Function
End If
End If
GetLocalPath = path
End If
Dim cid As String, fileNum As Long, line As Variant, parts() As String
Dim tag As String, mainMount As String, relPath As String, email As String
Dim b() As Byte, n As Long, i As Long, size As Long, libNr As String
Dim parentID As String, folderID As String, folderName As String
Dim folderIdPattern As String, fileName As String, folderType As String
Dim siteID As String, libID As String, webID As String, lnkID As String
Dim odFolders As Object, cliPolColl As Object, libNrToWebColl As Object
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)
#If Mac Then
Dim utf16() As Byte, utf32() As Byte, j As Long, k As Long, m As Long
Dim charCode As Long, lowSurrogate As Long, highSurrogate As Long
ReDim b(0 To 3): b(0) = &HAB&: b(1) = &HAB&: b(2) = &HAB&: b(3) = &HAB&
Dim sig3 As String: sig3 = b: sig3 = vbNullChar & vbNullChar & sig3
#Else
ReDim b(0 To 1): b(0) = &HAB&: b(1) = &HAB&
Dim sig3 As String: sig3 = b: sig3 = vbNullChar & sig3
#End If
Dim settPath As String, wDir As String, clpPath As String
#If Mac Then
s = Environ("HOME")
settPath = Left(s, InStrRev(s, "/Library/Containers")) & _
"Library/Containers/com.microsoft.OneDrive-mac/Data/" & _
"Library/Application Support/OneDrive/settings/"
clpPath = s & "/Library/Application Support/Microsoft/Office/CLP/"
#Else
settPath = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\"
clpPath = Environ("LOCALAPPDATA") & "\Microsoft\Office\CLP\"
#End If
#If Mac Then
Dim possibleDirs(0 To 11) As String: possibleDirs(0) = settPath
For i = 1 To 9: possibleDirs(i) = settPath & "Business" & i & ps: Next i
possibleDirs(10) = settPath & "Personal" & ps: possibleDirs(11) = clpPath
If Not GrantAccessToMultipleFiles(possibleDirs) Then _
Err.Raise vbErrPermissionDenied
#End If
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
#If Mac Then
s = ""
For Each dirName In oneDriveSettDirs
wDir = settPath & dirName & ps
cid = IIf(dirName = "Personal", "????????????????", _
"????????-????-????-????-????????????")
If dirName = "Personal" Then s = s & "//" & wDir & "GroupFolders.ini"
s = s & "//" & wDir & "global.ini"
fileName = Dir(wDir, vbNormal)
Do Until fileName = ""
If fileName Like cid & ".ini" Or _
fileName Like cid & ".dat" Or _
fileName Like "ClientPolicy*.ini" Then _
s = s & "//" & wDir & fileName
fileName = Dir
Loop
Next dirName
If Not GrantAccessToMultipleFiles(Split(Mid(s, 3), "//")) Then _
Err.Raise vbErrPermissionDenied
#End If
If Not locToWebColl Is Nothing And Not rebuildCache Then
s = ""
For Each dirName In oneDriveSettDirs
wDir = settPath & dirName & ps
cid = IIf(dirName = "Personal", "????????????????", _
"????????-????-????-????-????????????")
If Dir(wDir & "global.ini") <> "" Then _
s = s & "//" & wDir & "global.ini"
fileName = Dir(wDir, vbNormal)
Do Until fileName = ""
If fileName Like cid & ".ini" Then _
s = s & "//" & wDir & fileName
fileName = Dir
Loop
Next dirName
For Each vItem In Split(Mid(s, 3), "//")
If FileDateTime(vItem) > lastCacheUpdate Then _
rebuildCache = True: Exit For
Next vItem
If Not rebuildCache Then
If lastTimeNotFound Is Nothing Then _
Set lastTimeNotFound = New Collection
On Error Resume Next: lastTimeNotFound.Remove path: On Error GoTo 0
lastTimeNotFound.Add Item:=Now(), Key:=path
Exit Function
End If
End If
lastCacheUpdate = Now()
Set lastTimeNotFound = Nothing
Set locToWebColl = New Collection
For Each dirName In oneDriveSettDirs
wDir = settPath & dirName & ps
If Dir(wDir & "global.ini", vbNormal) = "" Then GoTo NextFolder
fileNum = FreeFile()
Open wDir & "global.ini" For Binary Access Read As #fileNum
ReDim b(0 To LOF(fileNum)): Get fileNum, , b
Close #fileNum: fileNum = 0
#If Mac Then
b = StrConv(b, vbUnicode)
#End If
For Each line In Split(b, vbNewLine)
If line Like "cid = *" Then cid = Mid(line, 7): Exit For
Next line
If cid = "" Then GoTo NextFolder
If (Dir(wDir & cid & ".ini") = "" Or _
Dir(wDir & cid & ".dat") = "") Then GoTo NextFolder
If dirName Like "Business#" Then
folderIdPattern = Replace(Space(32), " ", "[a-f0-9]")
ElseIf dirName = "Personal" Then
folderIdPattern = Replace(Space(16), " ", "[A-F0-9]") & "!###*"
End If
fileName = Dir(clpPath, vbNormal)
Do Until fileName = ""
If InStr(1, fileName, cid) And cid <> "" Then _
email = LCase(Left(fileName, InStr(fileName, cid) - 2)): Exit Do
fileName = Dir
Loop
Set cliPolColl = New Collection
fileName = Dir(wDir, vbNormal)
Do Until fileName = ""
If fileName Like "ClientPolicy*.ini" Then
fileNum = FreeFile()
Open wDir & fileName For Binary Access Read As #fileNum
ReDim b(0 To LOF(fileNum)): Get fileNum, , b
Close #fileNum: fileNum = 0
#If Mac Then
b = StrConv(b, vbUnicode)
#End If
cliPolColl.Add Key:=fileName, Item:=New Collection
For Each line In Split(b, vbNewLine)
If InStr(1, line, " = ", vbBinaryCompare) Then
tag = Left(line, InStr(line, " = ") - 1)
s = Mid(line, InStr(line, " = ") + 3)
Select Case tag
Case "DavUrlNamespace"
cliPolColl(fileName).Add Key:=tag, Item:=s
Case "SiteID", "IrmLibraryId", "WebID"
s = Replace(LCase(s), "-", "")
If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
cliPolColl(fileName).Add Key:=tag, Item:=s
End Select
End If
Next line
End If
fileName = Dir
Loop
fileNum = FreeFile
Open wDir & cid & ".dat" For Binary Access Read As #fileNum
ReDim b(0 To LOF(fileNum)): Get fileNum, , b: s = b: size = LenB(s)
Close #fileNum: fileNum = 0
Set odFolders = New Collection
For Each vItem In Array(16, 8)
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, sig3) - i) / 2) * 2
If n < 0 Then n = 0
#If Mac Then
utf32 = MidB$(s, i, n)
ReDim utf16(LBound(utf32) To UBound(utf32))
j = LBound(utf32): k = LBound(utf32)
Do While j < UBound(utf32)
If utf32(j + 2) = 0 And utf32(j + 3) = 0 Then
utf16(k) = utf32(j): utf16(k + 1) = utf32(j + 1)
k = k + 2
Else
If utf32(j + 3) <> 0 Then Err.Raise _
vbErrInvalidFormatInResourceFile
charCode = utf32(j + 2) * &H10000 + _
utf32(j + 1) * &H100& + utf32(j)
m = charCode - &H10000
highSurrogate = &HD800& + (m \ &H400&)
lowSurrogate = &HDC00& + (m And &H3FF)
utf16(k) = CByte(highSurrogate And &HFF&)
utf16(k + 1) = CByte(highSurrogate \ &H100&)
utf16(k + 2) = CByte(lowSurrogate And &HFF&)
utf16(k + 3) = CByte(lowSurrogate \ &H100&)
k = k + 4
End If
j = j + 4
Loop
ReDim Preserve utf16(LBound(utf16) To k - 1)
folderName = utf16
#Else
folderName = MidB$(s, i, n)
#End If
If folderID Like folderIdPattern Then
odFolders.Add VBA.Array(parentID, folderName), folderID
End If
End If
i = InStrB(i + 1, s, sig2)
Loop
If odFolders.Count > 0 Then Exit For
Next vItem
fileNum = FreeFile()
Open wDir & cid & ".ini" For Binary Access Read As #fileNum
ReDim b(0 To LOF(fileNum)): Get fileNum, , b
Close #fileNum: fileNum = 0
#If Mac Then
b = StrConv(b, vbUnicode)
#End If
Select Case True
Case dirName Like "Business#"
mainMount = "": Set libNrToWebColl = New Collection
For Each line In Split(b, vbNewLine)
webRoot = "": locRoot = ""
Select Case Left$(line, InStr(line, " = ") - 1)
Case "libraryScope"
parts = Split(line, """"): locRoot = parts(9)
If locRoot = "" Then libNr = Split(line, " ")(2)
folderType = parts(3): parts = Split(parts(8), " ")
siteID = parts(1): webID = parts(2): libID = parts(3)
If mainMount = "" And folderType = "ODB" Then
mainMount = locRoot: fileName = "ClientPolicy.ini"
Else: fileName = "ClientPolicy_" & libID & siteID & ".ini"
End If
On Error Resume Next
webRoot = cliPolColl(fileName)("DavUrlNamespace")
On Error GoTo 0
If webRoot = "" Then
For Each vItem In cliPolColl
If vItem("SiteID") = siteID And vItem("WebID") = _
webID And vItem("IrmLibraryId") = libID Then
webRoot = vItem("DavUrlNamespace"): Exit For
End If
Next vItem
End If
If webRoot = "" Then Err.Raise vbErrFileNotFound
If locRoot = "" Then
libNrToWebColl.Add VBA.Array(libNr, webRoot), libNr
Else: locToWebColl.Add VBA.Array(locRoot, webRoot, email), _
locRoot
End If
Case "libraryFolder"
locRoot = Split(line, """")(1): libNr = Split(line, " ")(3)
For Each vItem In libNrToWebColl
If vItem(0) = libNr Then
s = "": parentID = Left(Split(line, " ")(4), 32)
Do
On Error Resume Next: odFolders parentID
keyExists = (Err.Number = 0): On Error GoTo 0
If Not keyExists Then Exit Do
s = odFolders(parentID)(1) & "/" & s
parentID = odFolders(parentID)(0)
Loop
webRoot = vItem(1) & s: Exit For
End If
Next vItem
locToWebColl.Add VBA.Array(locRoot, webRoot, email), locRoot
Case "AddedScope"
parts = Split(line, """")
relPath = parts(5): If relPath = " " Then relPath = ""
parts = Split(parts(4), " "): siteID = parts(1)
webID = parts(2): libID = parts(3): lnkID = parts(4)
fileName = "ClientPolicy_" & libID & siteID & lnkID & ".ini"
On Error Resume Next
webRoot = cliPolColl(fileName)("DavUrlNamespace") & relPath
On Error GoTo 0
If webRoot = "" Then
For Each vItem In cliPolColl
If vItem("SiteID") = siteID And vItem("WebID") = _
webID And vItem("IrmLibraryId") = libID Then
webRoot = vItem("DavUrlNamespace") & relPath
Exit For
End If
Next vItem
End If
If webRoot = "" Then Err.Raise vbErrFileNotFound
s = "": parentID = Left(Split(line, " ")(3), 32)
Do
On Error Resume Next: odFolders parentID
keyExists = (Err.Number = 0): On Error GoTo 0
If Not keyExists Then Exit Do
s = odFolders(parentID)(1) & ps & s
parentID = odFolders(parentID)(0)
Loop
locRoot = mainMount & ps & s
locToWebColl.Add VBA.Array(locRoot, webRoot, email), locRoot
Case Else
Exit For
End Select
Next line
Case dirName = "Personal"
For Each line In Split(b, vbNewLine)
If line Like "library = *" Then _
locRoot = Split(line, """")(3): Exit For
Next line
On Error Resume Next
webRoot = cliPolColl("ClientPolicy.ini")("DavUrlNamespace")
On Error GoTo 0
If locRoot = "" Or webRoot = "" Or cid = "" Then GoTo NextFolder
locToWebColl.Add VBA.Array(locRoot, webRoot & "/" & cid, email), _
locRoot
If Dir(wDir & "GroupFolders.ini") = "" Then GoTo NextFolder
cid = "": fileNum = FreeFile()
Open wDir & "GroupFolders.ini" For Binary Access Read As #fileNum
ReDim b(0 To LOF(fileNum)): Get fileNum, , b
Close #fileNum: fileNum = 0
#If Mac Then
b = StrConv(b, vbUnicode)
#End If
For Each line In Split(b, vbNewLine)
If InStr(line, "BaseUri = ") And cid = "" Then
cid = LCase(Mid(line, InStrRev(line, "/") + 1, 16))
folderID = Left(line, InStr(line, "_") - 1)
ElseIf cid <> "" Then
locToWebColl.Add VBA.Array(locRoot & ps & odFolders( _
folderID)(1), webRoot & "/" & cid & "/" & _
Mid(line, Len(folderID) + 9), email), _
locRoot & ps & odFolders(folderID)(1)
cid = "": folderID = ""
End If
Next line
End Select
NextFolder:
cid = "": s = "": email = "": Set odFolders = Nothing
Next dirName
Dim tmpColl As Collection: Set tmpColl = New Collection
For Each vItem In locToWebColl
locRoot = vItem(0): webRoot = vItem(1): email = vItem(2)
If Right(webRoot, 1) = "/" Then webRoot = Left(webRoot, Len(webRoot) - 1)
If Right(locRoot, 1) = ps Then locRoot = Left(locRoot, Len(locRoot) - 1)
tmpColl.Add VBA.Array(locRoot, webRoot, email), locRoot
Next vItem
Set locToWebColl = tmpColl
GetLocalPath = GetLocalPath(path, False, returnAll, pmpo): Exit Function
End Function
How Do the Solutions Work?
Both solutions get all of the required information for translating the UrlPath/WebPath to a LocalPath from the OneDrive settings files inside of the directory %localappdata%\Microsoft\OneDrive\settings\....
This means, contrary to most other solutions online, the registry is not used! The reasons for this are explained in the Gist repository of Solution 2.
The following files will be read:
(Wildcards: * - zero or more characters; ? - one character)
????????????????.dat
????????????????.ini
global.ini
GroupFolders.ini
????????-????-????-????-????????????.dat
????????-????-????-????-????????????.ini
ClientPolicy*.ini
All of the .ini files can be read easily as they use UTF-16 encoding.
The .dat files are much more difficult to decipher, because they use a proprietary binary format. Luckily, the information we need can be extracted by looking for certain byte-patterns inside these files and copying and converting the data at a certain offset from these "signature" bytes.
Data from all of these files is used, to create a "dictionary" of all the local mount points on your pc, and their corresponding WebPath. For example, for your personal OneDrive, such a local mount point could look like this:
C:\Users\Username\OneDrive, and the corresponding WebPath could look like this: https://d.docs.live.net/f9d8c1184686d493.
This "dictionary" can then be used to "translate" a given WebPath to a local path by replacing the part that is equal to one of the elements of the dictionary with the corresponding local mount point. For example, this WebPath: https://d.docs.live.net/f9d8c1184686d493/Folder/File.xlsm will be correctly "translated" to C:\Users\Username\OneDrive\Folder\File.xlsm
Because all possible WebPaths for the local machine can be translated by the same dictionary, it is implemented as Static in both solutions. This means it will only be written the first time the function is called, all subsequent function calls will find the "dictionary" already initialized leading to shorter run time.
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:
Nr.
Author
Solution
Tests passed
1
Koen Rijnsent
https://stackoverflow.com/a/71753164/12287457
0/46
2
Cooz2, adapted for Excel by LucasHol
https://social.msdn.microsoft.com/Forums/office/en-US/1331519b-1dd1-4aa0-8f4f-0453e1647f57/how-to-get-physical-path-instead-of-url-onedrive
0/46
3
Julio Garcia
https://stackoverflow.com/a/74360506/12287457
0/46
4
Claude
https://stackoverflow.com/a/64657459/12287457
0/46
5
Variatus
https://stackoverflow.com/a/68568909/12287457
0/46
6
MatChrupczalski
https://social.msdn.microsoft.com/Forums/office/en-US/1331519b-1dd1-4aa0-8f4f-0453e1647f57/how-to-get-physical-path-instead-of-url-onedrive
1/46
7
Caio Silva
https://stackoverflow.com/a/67318424/12287457 and https://stackoverflow.com/a/67326133/12287457
2/46
8
Alain YARDIM
https://stackoverflow.com/a/65967886/12287457
2/46
9
tsdn
https://stackoverflow.com/a/56326922/12287457
2/46
10
Peter G. Schild
https://stackoverflow.com/a/60990170/12287457
2/46
11
TWMIC
https://stackoverflow.com/a/64591370/12287457
3/46
12
Horoman
https://stackoverflow.com/a/60921115/12287457
4/46
13
Philip Swannell
https://stackoverflow.com/a/54182663/12287457
4/46
14
RMK
https://stackoverflow.com/a/67697487/12287457
5/46
15
beerockxs
https://stackoverflow.com/a/67582367/12287457
5/46
16
Virtuoso
https://stackoverflow.com/a/33935405/12287457
5/46
17
COG
https://stackoverflow.com/a/51316641/12287457
5/46
18
mohnston
https://stackoverflow.com/a/68569925/12287457
5/46
19
Tomoaki Tsuruya (鶴谷　朋亮)
https://tsurutoro.com/vba-trouble2/
5/46
20
Greedo
https://gist.github.com/Greedquest/ 52eaccd25814b84cc62cbeab9574d7a3
6/45
21
Christoph Ackermann
https://stackoverflow.com/a/62742852/12287457
6/46
22
Schoentalegg
https://stackoverflow.com/a/57040668/12287457
6/46
23
Erlandsen Data Consulting
https://www.erlandsendata.no/?t=vbatips&p=4079
7/46
24
Kurobako (黒箱)
https://kuroihako.com/vba/onedriveurltolocalpath/
7/46
25
Tim Williams
https://stackoverflow.com/a/70610729/12287457
8/46
26
Erik van der Neut
https://stackoverflow.com/a/72709568/12287457
8/46
27
Ricardo Diaz
https://stackoverflow.com/a/65605893/12287457
9/46
28
Iksi
https://stackoverflow.com/a/68963896/12287457
11/46
29
Gustav Brock, Cactus Data ApS
https://stackoverflow.com/a/70521246/12287457
11/46
30
Ricardo Gerbaudo
https://stackoverflow.com/a/69929678/12287457
14/46
31
Guido Witt-Dörring Short solution
https://stackoverflow.com/a/72736924/12287457
24/46
32
Ion Cristian Buse
https://github.com/cristianbuse/VBA-FileTools
46/46
33
Guido Witt-Dörring Universal Solution
https://gist.github.com/guwidoe/ 038398b6be1b16c458365716a921814d
46/46
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 33 would pass 0/46 tests. I suspect that my solution (Nr 33) would also pass every test on macOS, however I was not able to test this rigorously.
Most solutions pass very few tests. Many of these tests are relatively dificult 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.
Another reason why many solutions perform poorly is that the environment variables Environ("OneDrive"), Environ("OneDriveCommercial"),Environ("OneDriveConsumer"), which many solutions build on, are not reliable, especially when you have multiple business OneDrive accounts logged in at the same time, like I do. Note that even if they always returned their expected values, it would be way to little information to solve all cases.
If you have another different solution you would like me to test, let me know and I'll add it to this section.

Answer 2

I found a thread online which contained enough information to put something simple together to solve this. I actually implemented the solution in Ruby, but this is the VBA version:
Option Explicit
Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
Dim Ctr As Long
Dim objShell As Object
Dim UserProfilePath As String
'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
'Replace forward slashes with back slashes
Local_Workbook_Name = Replace(wb.FullName, "/", "\")
'Get environment path using vbscript
Set objShell = CreateObject("WScript.Shell")
UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")
'Trim OneDrive designators
For Ctr = 1 To 4
Local_Workbook_Name = Mid(Local_Workbook_Name, InStr(Local_Workbook_Name, "\") + 1)
Next
'Construct the name
Local_Workbook_Name = UserProfilePath & "\OneDrive\" & Local_Workbook_Name
Else
Local_Workbook_Name = wb.FullName
End If
End Function
Private Sub testy()
MsgBox ActiveWorkbook.FullName & vbCrLf & Local_Workbook_Name(ActiveWorkbook)
End Sub

Answer 3

Horoman's version (2020-03-30) is good because it works on both private and commercial OneDrive. However it crashed on me because the line "LocalFullName = oneDrivePath & Application.PathSeparator & endFilePath" inserts a slash between oneDrivePath & endFilePath. Moreover, one should really try out paths "OneDriveCommercial" and "OneDriveConsumer" before "OneDrive". So here's the code that works for me:
Sub TestLocalFullName()
Debug.Print "URL: " & ActiveWorkbook.FullName
Debug.Print "Local: " & LocalFullName(ActiveWorkbook.FullName)
Debug.Print "Test: " & Dir(LocalFullName(ActiveWorkbook.FullName))
End Sub
Private Function LocalFullName$(ByVal fullPath$)
'Finds local path for a OneDrive file URL, using environment variables of OneDrive
'Reference https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive
'Authors: Philip Swannell 2019-01-14, MatChrupczalski 2019-05-19, Horoman 2020-03-29, P.G.Schild 2020-04-02
Dim ii&
Dim iPos&
Dim oneDrivePath$
Dim endFilePath$
If Left(fullPath, 8) = "https://" Then 'Possibly a OneDrive URL
If InStr(1, fullPath, "my.sharepoint.com") <> 0 Then 'Commercial OneDrive
'For commercial OneDrive, path looks like "https://companyName-my.sharepoint.com/personal/userName_domain_com/Documents" & file.FullName)
'Find "/Documents" in string and replace everything before the end with OneDrive local path
iPos = InStr(1, fullPath, "/Documents") + Len("/Documents") 'find "/Documents" position in file URL
endFilePath = Mid(fullPath, iPos) 'Get the ending file path without pointer in OneDrive. Include leading "/"
Else 'Personal OneDrive
'For personal OneDrive, path looks like "https://d.docs.live.net/d7bbaa#######1/" & file.FullName
'We can get local file path by replacing "https.." up to the 4th slash, with the OneDrive local path obtained from registry
iPos = 8 'Last slash in https://
For ii = 1 To 2
iPos = InStr(iPos + 1, fullPath, "/") 'find 4th slash
Next ii
endFilePath = Mid(fullPath, iPos) 'Get the ending file path without OneDrive root. Include leading "/"
End If
endFilePath = Replace(endFilePath, "/", Application.PathSeparator) 'Replace forward slashes with back slashes (URL type to Windows type)
For ii = 1 To 3 'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
oneDrivePath = Environ(Choose(ii, "OneDriveCommercial", "OneDriveConsumer", "OneDrive")) 'Check possible local paths. "OneDrive" should be the last one
If 0 < Len(oneDrivePath) Then
LocalFullName = oneDrivePath & endFilePath
Exit Function 'Success (i.e. found the correct Environ parameter)
End If
Next ii
'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
LocalFullName = vbNullString
Else
LocalFullName = fullPath
End If
End Function

Answer 4

I have adjusted the function provided by others to account for some additional constraints:
When you share files via a team site, it's not "my.sharepoint.com/" but "sharepoint.com/" that you should use to determine if it's a commercial version.
It is better to count the slashes rather than using the position of "/Documents" because, for example in French, the document folder is called "Documents partages". It is preferable to count 4 slashes for commercial use and 2 slashes for personal use.
If the SharePoint folder added as a shortcut to OneDrive is not at the root, the local address on the hard drive does not contain parent folders on the SharePoint.
Here is the code that takes my changes into account:
Public Function AdresseLocal$(ByVal fullPath$)
'Finds local path for a OneDrive file URL, using environment variables of OneDrive
'Reference https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive
'Authors: Philip Swannell 2019-01-14, MatChrupczalski 2019-05-19, Horoman 2020-03-29, P.G.Schild 2020-04-02
Dim ii&
Dim iPos&
Dim oneDrivePath$
Dim endFilePath$
Dim NbSlash
If Left(fullPath, 8) = "https://" Then
If InStr(1, fullPath, "sharepoint.com/") <> 0 Then 'Commercial OneDrive
NbSlash = 4
Else 'Personal OneDrive
NbSlash = 2
End If
iPos = 8 'Last slash in https://
For ii = 1 To NbSlash
iPos = InStr(iPos + 1, fullPath, "/")
Next ii
endFilePath = Mid(fullPath, iPos)
endFilePath = Replace(endFilePath, "/", Application.PathSeparator)
For ii = 1 To 3
oneDrivePath = Environ(Choose(ii, "OneDriveCommercial", "OneDriveConsumer", "OneDrive"))
If 0 < Len(oneDrivePath) Then Exit For
Next ii
AdresseLocal = oneDrivePath & endFilePath
While Len(Dir(AdresseLocal, vbDirectory)) = 0 And InStr(2, endFilePath, Application.PathSeparator) > 0
endFilePath = Mid(endFilePath, InStr(2, endFilePath, Application.PathSeparator))
AdresseLocal = oneDrivePath & endFilePath
Wend
Else
AdresseLocal = fullPath
End If
End Function
...which builds on the work of the different contributors.

Answer 5

It's possible to improve on Virtuoso's answer to reduce (though not eliminate) the chance that the function returns a "wrong" file location. The problem is that there are various URLs that a workbook's .FullName can be. These are three I'm aware of:
A URL associated with the user's OneDrive
A URL associated with the user's OneDrive for Business
A URL associated with somebody else's OneDrive in the case that that other person has "shared" the file (in which case you open the file via File > Open > Shared with me)
On my PC I can get the relevant local folders to map the first two URLs via the OneDriveConsumer and OneDriveCommercial environment variables, that exist in addition to the OneDrive environment variable, so the code below makes use of these. I'm not aware that it's possible to handle the "Shared with Me" files and the code below will return their https://-style location.
Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
Dim i As Long, j As Long
Dim OneDrivePath As String
Dim ShortName As String
'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
'Replace forward slashes with back slashes
ShortName = Replace(wb.FullName, "/", "\")
'Remove the first four backslashes
For i = 1 To 4
ShortName = Mid(ShortName, InStr(ShortName, "\") + 1)
Next
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
For j = 1 To 3
OneDrivePath = Environ(Choose(j, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(OneDrivePath) > 0 Then
Local_Workbook_Name = OneDrivePath & "\" & ShortName
If Dir(Local_Workbook_Name) <> "" Then
Exit Function
End If
End If
Next j
'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
End If
Local_Workbook_Name = wb.FullName
End Function
Unfortunately, if files exist with identical paths within both the OneDrive folder and the OneDrive for Business folder, then the code can't distinguish between them, and may return the "wrong one". I don't have a solution for that.

Answer 6

I like the Version from TWMIC with the use of the Registry. All other Version did not work at my oneDrive for Business. There are some folders where the name is slightly different to the URL, for example in the URL are partly no spaces but in the folder there are. If it is from Teams and in the Team Name are spaces then this is a problem. Even the Folder Names from Teams are different than the URL, depending which folder level in Teams you are syncing.
The Version from TWMIC is tagged as dangerous at my work computer and i can't use it, very sad about that.
So i made a Version which reads the ini File from oneDrive for Busines, if it is OneDrive for Business...
Public Function AdresseLocal$(ByVal fullPath$)
'Finds local path for a OneDrive file URL, using environment variables of OneDrive and loading the settings ini File of OneDrive
'Reference https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive
'Authors: Philip Swannell 2019-01-14, MatChrupczalski 2019-05-19, Horoman 2020-03-29, P.G.Schild 2020-04-02, Iksi 2021-08-28
Dim ScreenUpdate As Boolean
Dim ii&
Dim iPos&
Dim DatFile$, SettingsDir$, Temp$
Dim oneDrivePath$, oneDriveURL$
Dim endFilePath$
If Left(fullPath, 8) = "https://" Then
If InStr(1, fullPath, "sharepoint.com") <> 0 Then 'Commercial OneDrive
'Find the correct settings File, I'm not sure if it is always in Folder Business1, so trying to find a Folder Business and then Business1, 2 ....
'First find *.dat File, seems to be only one of that type, the correct ini File is the same Name than the dat File
DatFile = Dir(Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business\*.dat")
If DatFile <> "" Then SettingsDir = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business\"
For ii = 1 To 9
Temp = Dir(Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business" & ii & "\*.dat")
If Temp <> "" Then
If SettingsDir = "" Then
DatFile = Temp
SettingsDir = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business" & ii & "\"
Else
MsgBox "There is more than one OneDrive settings Folder!"
End If
End If
Next
'Open ini File without showing
ScreenUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
Workbooks.OpenText Filename:= _
SettingsDir & Left(DatFile, Len(DatFile) - 3) & "ini" _
, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:= _
False, Comma:=False, Space:=True, Other:=False, TrailingMinusNumbers:=True
ii = 1
Do While Cells(ii, 1) = "libraryScope"
'Search the correct URL which fits to the fullPath and then search the corresponding Folder
If InStr(fullPath, Cells(ii, 9)) = 1 Then
oneDriveURL = Cells(ii, 9)
If Cells(ii, 15) <> "" Then
oneDrivePath = Cells(ii, 15)
Else
iPos = Cells(ii, 3)
Do Until Cells(ii, 1) = "libraryFolder"
ii = ii + 1
Loop
Do While Cells(ii, 1) = "libraryFolder"
If Cells(ii, 4) = iPos Then
oneDrivePath = Cells(ii, 7)
Exit Do
End If
ii = ii + 1
Loop
End If
Exit Do
End If
ii = ii + 1
Loop
ActiveWorkbook.Close False
Application.ScreenUpdating = ScreenUpdate
endFilePath = Mid(fullPath, Len(oneDriveURL) + 1)
Else 'Personal OneDrive
'For personal OneDrive, path looks like "https://d.docs.live.net/d7bbaa#######1/" & file.FullName
'We can get local file path by replacing "https.." up to the 4th slash, with the OneDrive local path obtained from registry
iPos = 8 'Last slash in https://
For ii = 1 To 2
iPos = InStr(iPos + 1, fullPath, "/") 'find 4th slash
Next ii
endFilePath = Mid(fullPath, iPos) 'Get the ending file path without OneDrive root. Include leading "/"
End If
endFilePath = Replace(endFilePath, "/", Application.PathSeparator)
If Len(oneDrivePath) <= 0 Then
For ii = 1 To 3 'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
oneDrivePath = Environ(Choose(ii, "OneDriveCommercial", "OneDriveConsumer", "OneDrive")) 'Check possible local paths. "OneDrive" should be the last one
Next ii
End If
AdresseLocal = oneDrivePath & endFilePath
While Len(Dir(AdresseLocal, vbDirectory)) = 0 And InStr(2, endFilePath, Application.PathSeparator) > 0
endFilePath = Mid(endFilePath, InStr(2, endFilePath, Application.PathSeparator))
AdresseLocal = oneDrivePath & endFilePath
Wend
Else
AdresseLocal = fullPath
End If
End Function
For me this works great!

Answer 7

Easy Fix (early 2019) - For anyone else having this issue:
OneDrive > Settings > Office:
- Uncheck 'Use Office applications to sync Office files that I open'
This lets excel save the file in the typical "C:\Users[UserName]\OneDrive..." file format instead of the UNC "https:\" format.

Answer 8

Short solution
The solution presented in the following does not work in absolutely all cases, but it probably works in more than 99% of real-world scenarios. If you are looking for a solution that covers even the edge cases, please look at this universal solution.
An advantage of this solution compared to the above linked universal solution is its simplicity and therefore its lower likelihood to break because of OneDrive/Windows updates.
The function to convert the "WebPath" to a local path looks like this:
Public Function GetLocalPath(ByVal Path As String) As String
Const HKCU = &H80000001
Dim objReg As Object, rPath As String, subKeys(), subKey
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(Path, urlNamespace) > 0 Then
objReg.GetStringValue HKCU, rPath & subKey, "MountPoint", mountPoint
secPart = Replace(Mid(Path, Len(urlNamespace)), "/", "\")
Path = mountPoint & secPart
Do Until Dir(Path, vbDirectory) <> "" Or InStr(2, secPart, "\") = 0
secPart = Mid(secPart, InStr(2, secPart, "\"))
Path = mountPoint & secPart
Loop
Exit For
End If
Next
GetLocalPath = Path
End Function
To now get the local full name of your workbook, just use GetLocalPath(ThisWorkbook.FullName)

Answer 9

Very helpful, thanks. I had a similar issue, but with a folder name rather than a filename. Consequently I modified it slightly. I made it work for folder names AND filenames (doesn't have to be a workbook). In case it's helpful, code is below:
Public Function Local_Name(theName As String) As String
Dim i As Integer
Dim objShell As Object
Dim UserProfilePath As String
' Check if it looks like a OneDrive location.
If InStr(1, theName, "https://", vbTextCompare) > 0 Then
' Replace forward slashes with back slashes.
Local_Name = Replace(theName, "/", "\")
'Get environment path using vbscript.
Set objShell = CreateObject("WScript.Shell")
UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")
' Trim OneDrive designators.
For i = 1 To 4
Local_Name = Mid(Local_Name, InStr(Local_Name, "\") + 1)
Next i
' Construct the name.
Local_Name = UserProfilePath & "\OneDrive\" & Local_Name
Else
' (must already be local).
Local_Name = theName
End If
End Function

Answer 10

This is really great stuff. I have run into this problem on some windows 10 machines but not others and it seems to come and go. I tried everything resetting OneDrive, changing the configuration etc. The only thing I tried that at least works on my machine is to use Fullname=CurDir & FileName, instead of FullName= activeworkbook.Path & FileName.
This returned the full local name without the https stuff and I was able to open my file ok.

Answer 11

I have the same problem as you.
But I have solved that problem.
The first I turn off OneDrive before I running the script.
you can add this script on the first script into your vba/module:
Call Shell("cmd.exe /S /C" & "%LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /shutdown")
and then, on your last script on your vba/module you can insert this for activate your OneDrive:
Call Shell("cmd.exe /S /C" & "start %LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /background")
I am using Windows10 on that script.

Answer 12

Instead of using the variable ThisWorkbook.Path use Environ("OneDrive").
Option Explicit
'
Function TransferURL(wbkURL As String) As String
' Converts the URL of a OneDrive into a path.
' Returns the path's name.
Dim oFs As Object
Dim oFl As Object
Dim oSubFl As Object
Dim pos As Integer
Dim pathPart As String
Dim oneDrive As String
Dim subFl As String
Set oFs = CreateObject("Scripting.FileSystemObject")
' Check the version of OneDrive.
If VBA.InStr(1, _
VBA.UCase(wbkURL), "MY.SHAREPOINT.COM") = 0 Then
oneDrive = "OneDriveConsumer"
Else
oneDrive = "OneDriveCommercial"
End If
Set oFl = oFs.GetFolder(Environ(oneDrive))
' Iteration over OneDrive's subfolders.
For Each oSubFl In oFl.SUBFOLDERS
subFl = "/" & VBA.Mid(oSubFl.Path, _
VBA.Len(Environ(oneDrive)) + 2) & "/"
' Check if part of the URL.
If VBA.InStr(1, _
wbkURL, subFl) > 0 Then
' Determine the path after OneDrive's folder.
pos = VBA.InStr(1, _
wbkURL, subFl)
pathPart = VBA.Mid(VBA.Replace(wbkURL, "/", _
Application.PathSeparator), pos)
End If
Next
TransferURL = Environ(oneDrive) & pathPart
End Function
Call the function by:
' Check if path specification as URL.
If VBA.Left(VBA.UCase(oWbk.Path), _
5) = "HTTPS" Then
' Call ...
pathName = TransferURL(oWbk.Path)
End If
The differentiation between OneDriveConsumer and OneDriveCommercial is derived from:
https://social.msdn.microsoft.com/Forums/en-US/1331519b-1dd1-4aa0-8f4f-0453e1647f57/how-to-get-physical-path-instead-of-url-onedrive?forum=officegeneral
Edited by MatChrupczalski Thursday, May 9, 2019 5:45 PM

Answer 13

Option Explicit
Private coll_Locations As Collection ' using Collection but could just as easily use Dictionary
Public Const HKEY_CURRENT_USER = &H80000001
'
Public Function getOneDrv_PathFor(ByVal sPath As String, Optional ByVal sType As String = "") As String
' convert start of passed in path from URL to Local or vice.versa, (for OneDrive Sync'd folders)
' sType : if starts L(ocal) return local path, if starts U(rl) then return URL Path, else return other mode to that passed in
Dim sPathNature As String
Dim vKey As Variant
Dim Slash As String, Slash2 As String
getOneDrv_PathFor = sPath ' return unchanged if no action required or recognised
sType = UCase(Left(sType, 1))
If sType <> "L" And sType <> "U" Then sType = ""
sPathNature = IIf(Left(sPath, 4) = "http", "U", "L")
If sType <> "" And sType = sPathNature Then Exit Function ' nothing to do
If coll_Locations Is Nothing Then get_Locations
For Each vKey In coll_Locations
If InStr(1, sPath, vKey, vbTextCompare) = 1 Then
Slash = IIf(sPathNature = "U", "/", "\")
Slash2 = IIf(Slash = "/", "\", "/")
getOneDrv_PathFor = coll_Locations(vKey) & Replace(Mid(sPath, Len(vKey) + 1), Slash, Slash2)
Exit For
End If
Next
End Function
Private Sub get_Locations()
' collect possible OneDrive: URL vs Local paths
Dim oWMI As Object
Dim sRegPath As String, arrSubKeys() As Variant, vSubKey As Variant
Dim sServiceEndPointUri As String, sUserFolder As String
Set coll_Locations = New Collection
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
sRegPath = "Software\Microsoft\OneDrive\Accounts\"
oWMI.EnumKey HKEY_CURRENT_USER, sRegPath, arrSubKeys
For Each vSubKey In arrSubKeys
oWMI.GetStringValue HKEY_CURRENT_USER, sRegPath & vSubKey, "ServiceEndPointUri", sServiceEndPointUri
oWMI.GetStringValue HKEY_CURRENT_USER, sRegPath & vSubKey, "UserFolder", sUserFolder
If sServiceEndPointUri <> "" And sUserFolder <> "" Then
If Right(sServiceEndPointUri, 5) = "/_api" Then sServiceEndPointUri = Left(sServiceEndPointUri, Len(sServiceEndPointUri) - 4) & "Documents/"
sUserFolder = sUserFolder & "\"
coll_Locations.Add Item:=sServiceEndPointUri, Key:=sUserFolder
coll_Locations.Add Item:=sUserFolder, Key:=sServiceEndPointUri
End If
Next
'listOneDrv_Locations
Set oWMI = Nothing
End Sub
Public Sub listOneDrv_Locations()
' to list what's in the collection
Dim vKey As Variant
' Set coll_Locations = Nothing
If coll_Locations Is Nothing Then get_Locations
For Each vKey In coll_Locations
Debug.Print vKey, coll_Locations(vKey)
Next
End Sub
Then to get the LocalPath would be
strLocalPath = getOneDrv_PathFor(strCurrentPath, "Local")

Answer 14

I know the question was tagged with VBA, but I found this while I was trying to solve with C#. I wrote a version similar to #TWMIC answer as the following:
string LocalPath( string fullPath )
{
if ( fullPath.StartsWith( "https://", StringComparison.InvariantCultureIgnoreCase ) )
{
// So Documents/ location works below
fullPath = fullPath.Replace( "\\", "/" );
var userAccounts = Microsoft.Win32.Registry.CurrentUser
.OpenSubKey(#"Software\Microsoft\OneDrive\Accounts\");
if (userAccounts != null)
{
foreach (var accountName in userAccounts.GetSubKeyNames())
{
var account = userAccounts.OpenSubKey(accountName);
var endPoint = account.GetValue("ServiceEndPointUri") as string;
var userFolder = account.GetValue("UserFolder") as string;
if (!string.IsNullOrEmpty(endPoint) && !string.IsNullOrEmpty(userFolder))
{
if (endPoint.EndsWith("/_api"))
{
endPoint = endPoint.Substring(0, endPoint.Length - 4) + "documents/";
}
if (fullPath.StartsWith(endPoint, StringComparison.InvariantCultureIgnoreCase))
{
return Path.Combine(userFolder, fullPath.Substring(endPoint.Length));
}
}
}
}
}
return fullPath;
}

Answer 15

I guess there is a little bug in the code of JK2017: The"ShortName"-variable has to be rebuilt at every start of these 3 versions of OneDrive. So ist has to be inside the 'For i = 1 To 3' loop.
I have also added the choise to get only the path instead of the full filename.
Private Function Local_Workbook_Name(ByRef wb As Workbook, Optional bPathOnly As Boolean = False) As String
'returns local wb path or nothing if local path not found
Dim i As Long, x As Long
Dim OneDrivePath As String
Dim ShortName As String
Dim testWbkPath As String
Dim OneDrivePathFound As Boolean
'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
'loop through three OneDrive options
For i = 1 To 3
'Replace forward slashes with back slashes
ShortName = Replace(wb.FullName, "/", "\")
'Remove the first four backslashes
For x = 1 To 4
ShortName = RemoveTopFolderFromPath(ShortName)
Next
'Choose the version of Onedrive
OneDrivePath = Environ(Choose(i, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(OneDrivePath) > 0 Then
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
Do While ShortName Like "*\*"
testWbkPath = OneDrivePath & "\" & ShortName
If Not (Dir(testWbkPath)) = vbNullString Then
OneDrivePathFound = True
Exit Do
End If
'remove top folder in path
ShortName = RemoveTopFolderFromPath(ShortName)
Loop
End If
If OneDrivePathFound Then Exit For
Next i
Else
If bPathOnly Then
Local_Workbook_Name = RemoveFileNameFromPath(wb.FullName)
Else
Local_Workbook_Name = wb.FullName
End If
End If
If OneDrivePathFound Then
If bPathOnly Then
Local_Workbook_Name = RemoveFileNameFromPath(testWbkPath)
Else
Local_Workbook_Name = testWbkPath
End If
End If
End Function
Function RemoveTopFolderFromPath(ByVal ShortName As String) As String
RemoveTopFolderFromPath = Mid(ShortName, InStr(ShortName, "\") + 1)
End Function
Function RemoveFileNameFromPath(ByVal ShortName As String) As String
RemoveFileNameFromPath = Mid(ShortName, 1, Len(ShortName) - InStr(StrReverse(ShortName), "\"))
End Function

Answer 16

The different number of slashes "/" could be related with different versions of OneDrive (private/professional). Compare MatChrupczalski post on the msdn website:
https://social.msdn.microsoft.com/Forums/en-US/1331519b-1dd1-4aa0-8f4f-0453e1647f57/how-to-get-physical-path-instead-of-url-onedrive?forum=officegeneral
Therefore I adapted the function to the following:
Sub TestMySolution()
MsgBox ActiveWorkbook.FullName & vbCrLf & LocalFullName(ActiveWorkbook.FullName)
End Sub
' 29.03.2020 Horoman
' main parts by Philip Swannell 14.01.2019
' combined with parts from MatChrupczalski 19.05.2019
' using environment variables of OneDrive
Private Function LocalFullName(ByVal fullPath As String) As String
Dim i As Long, j As Long
Dim oneDrivePath As String
Dim endFilePath As String
Dim iDocumentsPosition As Integer
'Check if it looks like a OneDrive location
If InStr(1, fullPath, "https://", vbTextCompare) > 0 Then
'for commercial OneDrive file path seems to be like "https://companyName-my.sharepoint.com/personal/userName_domain_com/Documents" & file.FullName)
If InStr(1, fullPath, "my.sharepoint.com") <> 0 Then
'find "/Documents" in string and replace everything before the end with OneDrive local path
iDocumentsPosition = InStr(1, fullPath, "/Documents") + Len("/Documents") 'find "/Documents" position in file URL
endFilePath = Mid(fullPath, iDocumentsPosition) 'get the ending file path without pointer in OneDrive
Else
'for personal onedrive it looks like "https://d.docs.live.net/d7bbaa#######1/" & file.FullName, _
' by replacing "https.." with OneDrive local path obtained from registry we can get local file path
'Remove the first four backslashes
endFilePath = Mid(fullPath, 9) ' removes "https://" and with it two backslashes
For i = 1 To 2
endFilePath = Mid(endFilePath, InStr(endFilePath, "/") + 1)
Next
End If
'Replace forward slashes with back slashes (URL type to Windows type)
endFilePath = Replace(endFilePath, "/", Application.PathSeparator)
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
For j = 1 To 3
oneDrivePath = Environ(Choose(j, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(oneDrivePath) > 0 Then
LocalFullName = oneDrivePath & Application.PathSeparator & endFilePath
If Dir(LocalFullName) <> "" Then
Exit Function 'that is it - WE GOT IT
End If
End If
Next j
'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
LocalFullName = ""
End If
LocalFullName = fullPath
End Function
Have fun.

Answer 17

Hallo this is how I do it, I found my the path through "SOFTWARE\SyncEngines\Providers\OneDrive":
private static string GetLocalPath(string url)
{
try
{
var oneDriveKey = Registry.CurrentUser.OpenSubKey(#"Software\SyncEngines\Providers\OneDrive");
if (oneDriveKey != null)
{
foreach (var subKeyName in oneDriveKey.GetSubKeyNames())
{
var subKey = oneDriveKey.OpenSubKey(subKeyName);
if (subKey != null)
{
var urlNameSpace = subKey.GetValue("UrlNamespace").ToString().Trim('/');
if (url.Contains(urlNameSpace) && subKey.GetValue("MountPoint") is string localLibraryPath)
{
string restOfDocumentPath = url.Substring(urlNameSpace.Length);
restOfDocumentPath = restOfDocumentPath.Replace('/', '\\');
return localLibraryPath + restOfDocumentPath;
}
}
}
}
}
catch (Exception e)
{
Console.WriteLine(e.Message);
}
return string.Empty;
}

Answer 18

Here's a small improvement on Philip Swannell's improvement of Virtuoso's original answer for when the number of "\" to remove from the path is more than 4 / varies (depending on the file, i found i needed to remove 5 or sometimes 6 of these). The shortcomings mentioned by Philip are still there though.
Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
'returns local wb path or nothing if local path not found
Dim i As Long
Dim OneDrivePath As String
Dim ShortName As String
Dim testWbkPath As String
Dim OneDrivePathFound As Boolean
'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
'Replace forward slashes with back slashes
ShortName = Replace(wb.FullName, "/", "\")
'Remove the first four backslashes
For i = 1 To 4
ShortName = RemoveTopFolderFromPath(ShortName)
Next
'loop through three OneDrive options
For i = 1 To 3
OneDrivePath = Environ(Choose(i, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(OneDrivePath) > 0 Then
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
Do While ShortName Like "*\*"
testWbkPath = OneDrivePath & "\" & ShortName
If Not (Dir(testWbkPath)) = vbNullString Then
OneDrivePathFound = True
Exit Do
End If
'remove top folder in path
ShortName = RemoveTopFolderFromPath(ShortName)
Loop
End If
If OneDrivePathFound Then Exit For
Next i
Else
Local_Workbook_Name = wb.FullName
End If
If OneDrivePathFound Then Local_Workbook_Name = testWbkPath
End Function
Function RemoveTopFolderFromPath(ByVal ShortName As String) As String
RemoveTopFolderFromPath = Mid(ShortName, InStr(ShortName, "\") + 1)
End Function

Answer 19

Call me a hacker but the http reference on my machine is always the same so I looked at the local reference on my hard drive where the OneDrive could be found
Lets say that was C:\MyOneDrive\OneDrive then took all the other parts of the workbook path that weren't needed and added on the local part. Then switched the slash direction
folder = "C:\MyOneDrive\OneDrive" & Right(Application.ActiveWorkbook.Path, Len(Application.ActiveWorkbook.Path) - 72) & "\"
folder = Replace(folder, "/", "\")
My two lines covered all the cases on my machine!!

Answer 20

I solved this problem be creating a symbolic link (mklink /d). Opening files through a desktop shortcut to the link meant that WB.FullName always returned the file path using the symbolic link.

Answer 21

As you all seem to work on Windows-System you can also use the filescripting object:
Debug.Print
Debug.Print "ThisWorkbook.Path: "; ThisWorkbook.Path
Debug.Print "ThisWorkbook.FullName: "; ThisWorkbook.FullName
With CreateObject("Scripting.FileSystemObject")
Debug.Print "Scripting.fso: "; .GetAbsolutePathName(ThisWorkbook.Name)
End With

Answer 22

I solved this without VBA.
instead i used Powerquery.
first i use this formula in a cell, to get the path without filename and worksheetname.
=LEFT(CELL("filename";E8);FIND("[";CELL("filename";E8))-1)
Then i import the path as a table in powerquery: "Råfilsti"
I then have another query that has this as it's source, here i do some datawrangling on the https file path. I hardcoded my local onedrive path in the query but you can copy paste your onedrive root folder into a cell in excel and call that as a parameter to use in powerquery.
Then load that query into a table in the workbook.