This browser is no longer supported.
Upgrade to Microsoft Edge to take advantage of the latest features, security updates, and technical support.
I posted here about my OneDrive backup everything nightmare. Another bad dream has reared it's ugliness in VBA land: ThisWorkbook.Path and ThisWorkbook.FullName.
For some reason I absolutely cannot fathom, Excel returns a useless URL when reading these two properties in a workbook opened from any OneDrive or Sharepoint shared location. For example, ThisWorkbook.FullName value when opened from any location other than a OneDrive shared folder:
C:\Users\Public\Just Another Workbook.xlsx
But, put that workbook in any OneDrive shared folder, and this is returned:
https://datapros-my.sharepoint.com/personal/kjones\_dataautopros\_com/Documents/Just Another Workbook.xlsx
where the actual local path is:
C:\Users\Kevin Jones\OneDrive - Data Automation Professionals\Just Another Workbook.xlsx
Right off the bat it's painfully obvious that the URL is absolutely useless to anyone and everyone. One of the most common automation tasks that use ThisWorkbook.FullName or ThisWorkbook.Path is to navigate around inside the folder in which the workbook is located. There is no easy way to translate that URL into a local path. It is possible but it's a tricky operation - more on that later. What else is that URL good for? I have no idea.
The whole idea of sharing folders and files on a local drive is so that they can be used the same way as if they were in a non-shared folder. So we don't have to go to the online location and either download the file or open it in a browser. DropBox did it right. Google Drive did it right. So what were the Microsoft engineers thinking by exposing the URL versus the local path? Anyone have a clue?
A lot of people have said to turn off this OneDrive option. Even if that did work, it is no longer available in the current OneDrive UI/UX.
People have written URL parsers and file search routines to try to translate the URL into a local path. This StackOverflow thread got pretty crazy with ideas but none of the solutions worked in all scenarios. Remember that OneDrive supports one personal account, up to nine business accounts, and Sharepoint folders - each of these have different structures in their URLs without any obvious mapping to the folder on the local drive. I did find one possible solution in the StackOverflow thread that showed promise - I reworked it so that it worked in as many scenarios as I could find. I'm posting it below.
But, before we get to that, a message to Microsoft: Please refrain from serving up URLs in ThisWorkbook.FullName and ThisWorkbook.Path when the workbook is stored or opened on a local drive. It serves no purpose other than to annoy us and make our lives more difficult. It's also not reality as the workbook is, in fact, located on the local drive in a local folder - that's from where Excel opens it and saves it. Keep the URL an internal thing (I realize it's needed for real time collaboration) and, if you actually believe that someone out here can use it, add a new ThisWorkbook property such as SharedURL.
Below is the routine for getting the local path as it should be returned in FullName. It's been tested on multiple machines, Windows 10 and 11, and Sharepoint and OneDrive shared folders. Post to this thread if you make any improvements or fix any issues.
Public Function OneDriveLocalFilePath( _
Optional ByRef OneDriveFilePath As String _
) As String
' Returns the local file path given a URL to a file stored in a OneDrive or Sharepoint folder. For
' some reason the Excel Workbook properties Path and FullName return URLs instead of local paths.
'
' OneDriveFilePath - Any valid local path or URL referencing a OneDrive file. If the path cannot be
' resolved, the original path is returned.
Dim WScript As Object
Dim WinMgmtS As Object
Dim Result As String
Dim ProposedFilePath As String
Dim ConfirmedFilePath As String
Dim RegistryKey As Variant
Dim RegistryKeys As Variant
Dim Types As Variant
Dim CID As String
Dim MountPoint As String
Dim URLNamespace As String
Dim Path1 As String
Dim Path2 As String
Dim Directories As Variant
Dim ParentDirectory As String
' Default to the full name property of ThisWorkbook
If Len(OneDriveFilePath) = 0 Then
OneDriveFilePath = ThisWorkbook.FullName
End If
' Deterimine if the path is a URL or a local path
If Left(OneDriveFilePath, 8) = "https://" Then
' WScript and Winmgmts are used to navigate the registry
Set WScript = CreateObject("WScript.Shell")
Set WinMgmtS = GetObject("Winmgmts:root\default:StdRegProv")
' Enumerate the key HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive
If WinMgmtS.EnumKey(&H80000001, "SOFTWARE\SyncEngines\Providers\OneDrive", RegistryKeys, Types) = 0 Then
For Each RegistryKey In RegistryKeys
' Each key has three interesting values:
'
' CID - Some hash code sometimes used in the path
' URLNameSpace - The URL to a parent directory in the cloud
' MountPoint - The local path OneDrive uses to mirror files found in the URLNameSpace address
CID = vbNullString
MountPoint = vbNullString
URLNamespace = vbNullString
ProposedFilePath = vbNullString
ConfirmedFilePath = vbNullString
On Error Resume Next
CID = WScript.RegRead("HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive" & RegistryKey & "\CID")
MountPoint = WScript.RegRead("HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive" & RegistryKey & "\MountPoint")
URLNamespace = WScript.RegRead("HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive" & RegistryKey & "\URLNamespace")
On Error GoTo 0
' It's not always clear how for down the folder tree the URL and the mount point go so the file's parent is
' pulled from the OneDrivePath so that it can be compared with and without
Directories = Split(OneDriveFilePath, "/")
ParentDirectory = Directories(UBound(Directories) - 1)
' Remove any trailing slash from the URL name space
If Right(URLNamespace, 1) = "/" Then
URLNamespace = Left(URLNamespace, Len(URLNamespace) - 1)
End If
' Build two paths to test against: one without the CID and one with the CID
Path1 = URLNamespace & "/"
Path2 = URLNamespace & "/" & CID & "/"
' Try the path without the CID
If Left(OneDriveFilePath, Len(Path1)) = Path1 Then
' Try building the final local path from the mount point path and the unmatched end of the OneDrive path
' and return it if the file exists
ProposedFilePath = MountPoint & "" & Replace(Replace(Mid(OneDriveFilePath, Len(Path1) + 1), "/", ""), "%20", Space(1))
If ExistingFile(ProposedFilePath) Then
ConfirmedFilePath = ProposedFilePath
Exit For
End If
' Try building the final local path from the mount point path and the unmatched end of the OneDrive path
' but without the first folder and return it if the file exists
If Right(MountPoint, Len(ParentDirectory)) = ParentDirectory Then
ProposedFilePath = Replace(Replace(Mid(OneDriveFilePath, Len(Path1) + 1), "/", ""), "%20", Space(1))
ProposedFilePath = Mid(ProposedFilePath, InStr(ProposedFilePath, "") + 1)
ProposedFilePath = MountPoint & "" & ProposedFilePath
If ExistingFile(ProposedFilePath) Then
ConfirmedFilePath = ProposedFilePath
Exit For
End If
End If
End If
' Try building the final local path from the mount point path with the CID attached and the unmatched end
' of the OneDrive path and return it if the file exists
If Left(OneDriveFilePath, Len(Path2)) = Path2 Then
ProposedFilePath = Replace(Replace(Mid(OneDriveFilePath, Len(Path2)), "/", ""), "%20", Space(1))
ProposedFilePath = Mid(ProposedFilePath, InStr(ProposedFilePath, "") + 1)
ProposedFilePath = MountPoint & "" & ProposedFilePath
If ExistingFile(ProposedFilePath) Then
ConfirmedFilePath = ProposedFilePath
Exit For
End If
End If
Next RegistryKey
End If
' Return the confirmed file path if a valid path was found
If Len(ConfirmedFilePath) > 0 Then
Result = ConfirmedFilePath
Else
Result = OneDriveFilePath
End If
Else
' The path is not a URL so return it as-is
Result = OneDriveFilePath
End If
OneDriveLocalFilePath = Result
End Function
Public Function ExistingFile( _
ByVal FilePath As String _
) As Boolean
' Returns True if the file exists, False otherwise. This routine does not use the Dir technique as
' the Dir function resets any current Dir process.
'
' FilePath - Full path to the folder or file to be evaluated.
Dim Attributes As Long
On Error Resume Next
Attributes = GetAttr(FilePath)
ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0
Err.Clear
End Function
Kevin
A family of Microsoft spreadsheet software with tools for analyzing, charting, and communicating data
Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Hi Kevin,
Thanks very much for al your work on this, it has been really helpful.
Kevin,
Thank you for your continuted support of this code.
Thank you Niels.
Here is the latest code - all of it.
Public Function OneDriveLocalFilePath( _
Optional ByRef OneDriveFilePath As String, _
Optional ByVal ReturnFolderPathOnly As Boolean, _
Optional ByVal ReturnEmptyIfFileNotFound As Boolean _
) As String
' Returns the local file path given a URL to a file stored in a OneDrive or Sharepoint folder. For
' some reason the Excel Workbook properties Path and FullName return URLs instead of local paths.
'
' OneDriveFilePath - Any valid local path or URL referencing a OneDrive file. If the path cannot be
' resolved, the original path is returned.
'
' ReturnFolderPathOnly - Pass True to return the folder path only. This is the equivelant of
' ThisWorkbook.Path. Optional. If omitted then False is assumed.
'
' ReturnEmptyIfFileNotFound - Pass True to return an empty or null string if the file cannot be
' found, False to return an error message. Optional. If omitted then False is assumed.
'
' Notes
'
' Debugging information is written to a text file in the Dektop folder when the conditional
' compilation argument Debugging is set to -1. This argument can be set in this module or in the
' project properties dialog.
Const RegistryPath As String = "HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive\"
Dim WScript As Object
Dim WinMgmtS As Object
Dim Result As String
Dim ProposedFilePath As String
Dim ConfirmedFilePath As String
Dim RegistryKey As Variant
Dim RegistryKeys As Variant
Dim Types As Variant
Dim CID As String
Dim MountPoint As String
Dim WebURL As String
Dim URLNamespace As String
Dim FullRemotePath As String
Dim URLInstance As Long
Dim URL As String
Dim URLCount As Long
Dim LibraryType As String
Dim URLExtended As String
Dim LocalPartialPath As String
Dim PartialPathRootDirectory As String
Dim Pass As Long
Dim EntryCount As Long
Dim ExistsCount As Long
Dim Log As String
Dim LogFilePath As String
Dim FileNumber As Long
Dim FileLength As Long
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Entering OneDriveLocalFilePath"
' Default to the full name property of ThisWorkbook
If Len(OneDriveFilePath) = 0 Then
OneDriveFilePath = ThisWorkbook.FullName
End If
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "OneDrive file path: " & OneDriveFilePath
' Determine if the path is a URL or a local path
If Left(OneDriveFilePath, 8) = "https://" Then
' WScript and Winmgmts are used to navigate the registry
Set WScript = CreateObject("WScript.Shell")
Set WinMgmtS = GetObject("Winmgmts:root\default:StdRegProv")
For Pass = 1 To 2
ExistsCount = 0
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Evaluating registry entries in '" & RegistryPath & "'"
' Enumerate the key HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive
If WinMgmtS.EnumKey(&H80000001, Mid(RegistryPath, InStr(RegistryPath, "\") + 1), RegistryKeys, Types) = 0 Then
EntryCount = 0
For Each RegistryKey In RegistryKeys
OneDriveLocalFilePath_WriteDebuggingLog Log
' Each key has five values of interest:
'
' CID - Some hash code sometimes used in the path
' WebURL - The URL to a parent directory in the cloud - it seems to be a parent directory of the name space URL
' URLNameSpace - Another URL to a parent directory in the cloud - this is the main "name space" URL
' FullRemotePath - A third URL to a parent directory in the cloud - it seems to be a subordinate directory of the name space URL
' MountPoint - The local path OneDrive uses to mirror files found in the URLNameSpace address
CID = vbNullString
MountPoint = vbNullString
WebURL = vbNullString
URLNamespace = vbNullString
FullRemotePath = vbNullString
ProposedFilePath = vbNullString
On Error Resume Next
CID = WScript.RegRead(RegistryPath & RegistryKey & "\CID")
MountPoint = WScript.RegRead(RegistryPath & RegistryKey & "\MountPoint")
WebURL = WScript.RegRead(RegistryPath & RegistryKey & "\WebURL")
URLNamespace = WScript.RegRead(RegistryPath & RegistryKey & "\URLNamespace")
FullRemotePath = WScript.RegRead(RegistryPath & RegistryKey & "\FullRemotePath")
LibraryType = WScript.RegRead(RegistryPath & RegistryKey & "\LibraryType")
On Error GoTo 0
EntryCount = EntryCount + 1
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Evaluating registry entry " & EntryCount
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "Key:", (RegistryKey)
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "CID:", CID
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "WebURL:", WebURL
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "URLNamespace:", URLNamespace
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "FullRemotePath:", FullRemotePath
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "MountPoint:", MountPoint
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "LibraryType:", LibraryType
If Len(MountPoint) > 0 Then
URLCount = 0
For URLInstance = 1 To 3
Select Case URLInstance
Case 1
URL = URLNamespace
Case 2
URL = WebURL
Case 3
URL = FullRemotePath
End Select
If Len(URL) > 0 Then
URLCount = URLCount + 1
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "Evaluating URL:", URL
' Remove any trailing slash from URL
If Right(URL, 1) = "/" Then
URL = Left(URL, Len(URL) - 1)
End If
' Determine extended URL name space which may or may not include CID
If Len(CID) = 0 Then
URLExtended = URL
Else
URLExtended = URL & "/" & CID
If Left(OneDriveFilePath, Len(URLExtended)) <> URLExtended Then
URLExtended = URL
End If
End If
' Looking for a local file path only if the base of the path being evaluated matches the extended URL
If Left(OneDriveFilePath, Len(URLExtended)) = URLExtended Then
LocalPartialPath = Mid(OneDriveFilePath, Len(URLExtended) + 2)
LocalPartialPath = Replace(Replace(LocalPartialPath, "/", "\"), "%20", Space(1))
Do While Len(LocalPartialPath) > 0
' It's not clear how much of the local partial path is used for the local path so all possible paths are tried by removing the highest level folder each pass until there are none left
If InStr(LocalPartialPath, "\") > 0 Then
PartialPathRootDirectory = Left(LocalPartialPath, InStr(LocalPartialPath, "\") - 1)
Else
PartialPathRootDirectory = vbNullString
End If
If Pass = 1 Or Pass = 2 And LibraryType = "teamsite" And Right(MountPoint, Len(PartialPathRootDirectory)) = PartialPathRootDirectory Then
OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "Local partial path:", LocalPartialPath
If OneDriveLocalFilePath_FileExists(MountPoint & "\" & LocalPartialPath, ConfirmedFilePath, ExistsCount, Log) Then Exit For
Else
If Pass = 2 Then
OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "Not a team site or right part of directory of mount point does not match the first directory of the partial path."
End If
End If
' Remove the root directory and try again
If Len(PartialPathRootDirectory) > 0 Then
LocalPartialPath = Mid(LocalPartialPath, InStr(LocalPartialPath, "\") + 1)
Else
LocalPartialPath = vbNullString
End If
Loop
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "URL name does not match base of OneDrive file path."
End If
End If
Next URLInstance
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "No mount point found."
End If
If URLCount = 0 Then
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "No URLs were found."
End If
Next RegistryKey
' Return the confirmed file path if a valid path was found
If Len(ConfirmedFilePath) > 0 Then
If ReturnFolderPathOnly Then
Result = Left(ConfirmedFilePath, InStrRev(ConfirmedFilePath, "\") - 1)
Else
Result = ConfirmedFilePath
End If
Else
OneDriveLocalFilePath_WriteDebuggingLog Log
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "No local path was found."
End If
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "No registry entries were found."
Result = OneDriveFilePath
End If
If ExistsCount < 2 Then Exit For
If Pass = 1 Then
OneDriveLocalFilePath_WriteDebuggingLog Log
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "More than one existing file was found in the first pass."
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Doing another pass and adding an extra check for a team site with matching share drive base folder."
End If
Next Pass
Else
' The path is not a URL
If ExistingFile(OneDriveFilePath) Then
' The file exists so return it as-is
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Provided path name is not a URL and was found."
ExistsCount = 1
If ReturnFolderPathOnly Then
Result = Left(OneDriveFilePath, InStrRev(OneDriveFilePath, "\") - 1)
Else
Result = OneDriveFilePath
End If
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Provided path name is not a URL and was not found."
End If
End If
If ExistsCount = 0 Then
If Not ReturnEmptyIfFileNotFound Then
Result = "A local file path to an existing file was not found."
End If
End If
OneDriveLocalFilePath_WriteDebuggingLog Log
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "OneDrive result: " & Result
#If Debugging Then
LogFilePath = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\" & "OneDrive Local File Path.txt"
On Error Resume Next
Kill LogFilePath
On Error GoTo 0
FileNumber = FreeFile
Open LogFilePath For Binary Access Read Write Lock Read Write As FileNumber
Put FileNumber, , Log
Close FileNumber
#End If
OneDriveLocalFilePath = Result
End Function
Private Function OneDriveLocalFilePath_FileExists( _
ByRef ProposedFilePath As String, _
ByRef ConfirmedFilePath As String, _
ByRef ExistsCount As Long, _
ByRef Log As String _
) As Boolean
' Tests if file path exists. Internal use only.
OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "Checking proposed file path:", ProposedFilePath
If ProposedFilePath = ConfirmedFilePath Then
OneDriveLocalFilePath_WriteDebuggingLog Log, 3, "File path has already been confirmed."
OneDriveLocalFilePath_FileExists = True
Exit Function
End If
If ExistingFile(ProposedFilePath) Then
ConfirmedFilePath = ProposedFilePath
ExistsCount = ExistsCount + 1
OneDriveLocalFilePath_WriteDebuggingLog Log, 3, "File path exists."
OneDriveLocalFilePath_FileExists = True
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 3, "File path does not exist."
End If
End Function
Private Sub OneDriveLocalFilePath_WriteDebuggingLog( _
ByRef Log As String, _
Optional ByVal Indent As Long, _
Optional ByVal Message1 As String, _
Optional ByVal Message2 As String _
)
' Logs message to debugging log. Internal use only.
Const IndentSpace As Long = 2
Const SecondMessagePosition As Long = 55
Dim SpaceCount As Long
#If Not Debugging Then
Exit Sub
#End If
If Len(Message1) = 0 Then
Log = Log & vbCrLf
Else
If Len(Message2) > 0 Then
SpaceCount = SecondMessagePosition - ((Indent * 2) + Len(Message1) + 1)
If SpaceCount > -1 Then
Message2 = Space(SpaceCount) & Message2
Else
Message2 = Message2
End If
End If
If Len(Log) > 0 Then
Log = Log & vbCrLf
End If
Log = Log & Space(Indent * IndentSpace) & Message1 & Message2
End If
End Sub
And the supporting routine to check to see if a file exists:
Public Function ExistingFile( _
ByVal FilePath As String _
) As Boolean
' Return True if the file exists, False otherwise. This routine does not use the Dir technique as
' the Dir function resets any current Dir process.
'
' FilePath - Full path to the folder or file to be evaluated.
Dim Attributes As Long
On Error Resume Next
Attributes = GetAttr(FilePath)
ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0
Err.Clear
End Function
Kevin
Hi Kevin.
I will skip my long rant about how stupid it is we need this workaround, and how happy and impressed I am you have solved it.
There appears to be one small error.
OneDriveLocalFilePath is meant to work whether the file resides in a OneDrive or SharePoint folder, or it is in a folder untouched by synchronization (like my "C:\Users\NO\ZeroDrive" folder ;-) ). Of course, in the latter case, the workaround is not necessary, but we want to be able to write VBA code that works in all cases.
OneDriveLocalFilePath(,True) is meant to return what ThisWorkbook.Path should return, i.e., it removes the filename from the result.
However, if the file resides in my unsynchronized ZeroDrive folder, OneDriveLocalFilePath(,True) does not remove the filename!
The quickfix is to change an Else clause towards the end of the main function into this:
Else
' The path is not a URL so return it as-is
If ExistingFile(OneDriveFilePath) Then
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Provided path name is not a URL and was found."
ExistsCount = 1
If ReturnFolderPathOnly Then
Result = Left(OneDriveFilePath, InStrRev(OneDriveFilePath, "\") - 1)
Else
Result = OneDriveFilePath
End If
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Provided path name is not a URL and was not found."
End If
End If
(but it might be nicer with a minor rewrite so the code deleting the filename occurs only once, instead of once for URLs + once for non-URLs).
Thank you Danny for helping me improve this code.
We found and fixed an issue which had to do with how many possible paths to check to see which was valid. The two parts we are working with is the root from the registry called MountPoint. This is the root part of the path to the file starting with the drive letter or shared drive name. The other part of the path is derived from the URL. It is the part after the part matching the NameSpace URL. In the previous version we checked the MountPoint prepended to two versions of the file URL path (without the NameSpace part): the whole path and the whole path without the first directory. In the new version, we check all possible paths by continuously removing the highest level parent from the URL path until there is no path left. It turns out that Danny's file was found after removing two parent directories.
We made some other changes to the logic and content of the log.
Here is the latest code - all of it.
Public Function OneDriveLocalFilePath( _
Optional ByRef OneDriveFilePath As String, _
Optional ByVal ReturnFolderPathOnly As Boolean, _
Optional ByVal ReturnEmptyIfFileNotFound As Boolean _
) As String
' Returns the local file path given a URL to a file stored in a OneDrive or Sharepoint folder. For
' some reason the Excel Workbook properties Path and FullName return URLs instead of local paths.
'
' OneDriveFilePath - Any valid local path or URL referencing a OneDrive file. If the path cannot be
' resolved, the original path is returned.
'
' ReturnFolderPathOnly - Pass True to return the folder path only. This is the equivelant of
' ThisWorkbook.Path. Optional. If omitted then False is assumed.
'
' ReturnEmptyIfFileNotFound - Pass True to return an empty or null string if the file cannot be
' found, False to return an error message. Optional. If omitted then False is assumed.
'
' Notes
'
' Debugging information is written to a text file in the Dektop folder when the conditional
' compilation argument Debugging is set to -1. This argument can be set in this module or in the
' project properties dialog.
Const RegistryPath As String = "HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive\"
Dim WScript As Object
Dim WinMgmtS As Object
Dim Result As String
Dim ProposedFilePath As String
Dim ConfirmedFilePath As String
Dim RegistryKey As Variant
Dim RegistryKeys As Variant
Dim Types As Variant
Dim CID As String
Dim MountPoint As String
Dim WebURL As String
Dim URLNamespace As String
Dim FullRemotePath As String
Dim URLInstance As Long
Dim URL As String
Dim URLCount As Long
Dim LibraryType As String
Dim URLExtended As String
Dim LocalPartialPath As String
Dim PartialPathRootDirectory As String
Dim Pass As Long
Dim EntryCount As Long
Dim ExistsCount As Long
Dim Log As String
Dim LogFilePath As String
Dim FileNumber As Long
Dim FileLength As Long
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Entering OneDriveLocalFilePath"
' Default to the full name property of ThisWorkbook
If Len(OneDriveFilePath) = 0 Then
OneDriveFilePath = ThisWorkbook.FullName
End If
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "OneDrive file path: " & OneDriveFilePath
' Determine if the path is a URL or a local path
If Left(OneDriveFilePath, 8) = "https://" Then
' WScript and Winmgmts are used to navigate the registry
Set WScript = CreateObject("WScript.Shell")
Set WinMgmtS = GetObject("Winmgmts:root\default:StdRegProv")
For Pass = 1 To 2
ExistsCount = 0
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Evaluating registry entries in '" & RegistryPath & "'"
' Enumerate the key HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive
If WinMgmtS.EnumKey(&H80000001, Mid(RegistryPath, InStr(RegistryPath, "\") + 1), RegistryKeys, Types) = 0 Then
EntryCount = 0
For Each RegistryKey In RegistryKeys
OneDriveLocalFilePath_WriteDebuggingLog Log
' Each key has five values of interest:
'
' CID - Some hash code sometimes used in the path
' WebURL - The URL to a parent directory in the cloud - it seems to be a parent directory of the name space URL
' URLNameSpace - Another URL to a parent directory in the cloud - this is the main "name space" URL
' FullRemotePath - A third URL to a parent directory in the cloud - it seems to be a subordinate directory of the name space URL
' MountPoint - The local path OneDrive uses to mirror files found in the URLNameSpace address
CID = vbNullString
MountPoint = vbNullString
WebURL = vbNullString
URLNamespace = vbNullString
FullRemotePath = vbNullString
ProposedFilePath = vbNullString
On Error Resume Next
CID = WScript.RegRead(RegistryPath & RegistryKey & "\CID")
MountPoint = WScript.RegRead(RegistryPath & RegistryKey & "\MountPoint")
WebURL = WScript.RegRead(RegistryPath & RegistryKey & "\WebURL")
URLNamespace = WScript.RegRead(RegistryPath & RegistryKey & "\URLNamespace")
FullRemotePath = WScript.RegRead(RegistryPath & RegistryKey & "\FullRemotePath")
LibraryType = WScript.RegRead(RegistryPath & RegistryKey & "\LibraryType")
On Error GoTo 0
EntryCount = EntryCount + 1
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Evaluating registry entry " & EntryCount
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "Key:", (RegistryKey)
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "CID:", CID
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "WebURL:", WebURL
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "URLNamespace:", URLNamespace
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "FullRemotePath:", FullRemotePath
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "MountPoint:", MountPoint
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "LibraryType:", LibraryType
If Len(MountPoint) > 0 Then
URLCount = 0
For URLInstance = 1 To 3
Select Case URLInstance
Case 1
URL = URLNamespace
Case 2
URL = WebURL
Case 3
URL = FullRemotePath
End Select
If Len(URL) > 0 Then
URLCount = URLCount + 1
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "Evaluating URL:", URL
' Remove any trailing slash from URL
If Right(URL, 1) = "/" Then
URL = Left(URL, Len(URL) - 1)
End If
' Determine extended URL name space which may or may not include CID
If Len(CID) = 0 Then
URLExtended = URL
Else
URLExtended = URL & "/" & CID
If Left(OneDriveFilePath, Len(URLExtended)) <> URLExtended Then
URLExtended = URL
End If
End If
' Looking for a local file path only if the base of the path being evaluated matches the extended URL
If Left(OneDriveFilePath, Len(URLExtended)) = URLExtended Then
LocalPartialPath = Mid(OneDriveFilePath, Len(URLExtended) + 2)
LocalPartialPath = Replace(Replace(LocalPartialPath, "/", "\"), "%20", Space(1))
Do While Len(LocalPartialPath) > 0
' It's not clear how much of the local partial path is used for the local path so all possible paths are tried by removing the highest level folder each pass until there are none left
If InStr(LocalPartialPath, "\") > 0 Then
PartialPathRootDirectory = Left(LocalPartialPath, InStr(LocalPartialPath, "\") - 1)
Else
PartialPathRootDirectory = vbNullString
End If
If Pass = 1 Or Pass = 2 And LibraryType = "teamsite" And Right(MountPoint, Len(PartialPathRootDirectory)) = PartialPathRootDirectory Then
OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "Local partial path:", LocalPartialPath
If OneDriveLocalFilePath_FileExists(MountPoint & "\" & LocalPartialPath, ConfirmedFilePath, ExistsCount, Log) Then Exit For
Else
If Pass = 2 Then
OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "Not a team site or right part of directory of mount point does not match the first directory of the partial path."
End If
End If
' Remove the root directory and try again
If Len(PartialPathRootDirectory) > 0 Then
LocalPartialPath = Mid(LocalPartialPath, InStr(LocalPartialPath, "\") + 1)
Else
LocalPartialPath = vbNullString
End If
Loop
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "URL name does not match base of OneDrive file path."
End If
End If
Next URLInstance
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "No mount point found."
End If
If URLCount = 0 Then
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "No URLs were found."
End If
Next RegistryKey
' Return the confirmed file path if a valid path was found
If Len(ConfirmedFilePath) > 0 Then
If ReturnFolderPathOnly Then
Result = Left(ConfirmedFilePath, InStrRev(ConfirmedFilePath, "\") - 1)
Else
Result = ConfirmedFilePath
End If
Else
OneDriveLocalFilePath_WriteDebuggingLog Log
OneDriveLocalFilePath_WriteDebuggingLog Log, 1, "No local path was found."
End If
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "No registry entries were found."
Result = OneDriveFilePath
End If
If ExistsCount < 2 Then Exit For
If Pass = 1 Then
OneDriveLocalFilePath_WriteDebuggingLog Log
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "More than one existing file was found in the first pass."
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Doing another pass and adding an extra check for a team site with matching share drive base folder."
End If
Next Pass
Else
' The path is not a URL so return it as-is
If ExistingFile(OneDriveFilePath) Then
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Provided path name is not a URL and was found."
ExistsCount = 1
Result = OneDriveFilePath
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "Provided path name is not a URL and was not found."
End If
End If
If ExistsCount = 0 Then
If Not ReturnEmptyIfFileNotFound Then
Result = "A local file path to an existing file was not found."
End If
End If
OneDriveLocalFilePath_WriteDebuggingLog Log
OneDriveLocalFilePath_WriteDebuggingLog Log, 0, "OneDrive result: " & Result
#If Debugging Then
LogFilePath = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\" & "OneDrive Local File Path.txt"
On Error Resume Next
Kill LogFilePath
On Error GoTo 0
FileNumber = FreeFile
Open LogFilePath For Binary Access Read Write Lock Read Write As FileNumber
Put FileNumber, , Log
Close FileNumber
#End If
OneDriveLocalFilePath = Result
End Function
Private Function OneDriveLocalFilePath_FileExists( _
ByRef ProposedFilePath As String, _
ByRef ConfirmedFilePath As String, _
ByRef ExistsCount As Long, _
ByRef Log As String _
) As Boolean
' Tests if file path exists. Internal use only.
OneDriveLocalFilePath_WriteDebuggingLog Log, 2, "Checking proposed file path:", ProposedFilePath
If ProposedFilePath = ConfirmedFilePath Then
OneDriveLocalFilePath_WriteDebuggingLog Log, 3, "File path has already been confirmed."
OneDriveLocalFilePath_FileExists = True
Exit Function
End If
If ExistingFile(ProposedFilePath) Then
ConfirmedFilePath = ProposedFilePath
ExistsCount = ExistsCount + 1
OneDriveLocalFilePath_WriteDebuggingLog Log, 3, "File path exists."
OneDriveLocalFilePath_FileExists = True
Else
OneDriveLocalFilePath_WriteDebuggingLog Log, 3, "File path does not exist."
End If
End Function
Private Sub OneDriveLocalFilePath_WriteDebuggingLog( _
ByRef Log As String, _
Optional ByVal Indent As Long, _
Optional ByVal Message1 As String, _
Optional ByVal Message2 As String _
)
' Logs message to debugging log. Internal use only.
Const IndentSpace As Long = 2
Const SecondMessagePosition As Long = 55
Dim SpaceCount As Long
#If Not Debugging Then
Exit Sub
#End If
If Len(Message1) = 0 Then
Log = Log & vbCrLf
Else
If Len(Message2) > 0 Then
SpaceCount = SecondMessagePosition - ((Indent * 2) + Len(Message1) + 1)
If SpaceCount > -1 Then
Message2 = Space(SpaceCount) & Message2
Else
Message2 = Message2
End If
End If
If Len(Log) > 0 Then
Log = Log & vbCrLf
End If
Log = Log & Space(Indent * IndentSpace) & Message1 & Message2
End If
End Sub
And the supporting routine to check to see if a file exists:
Public Function ExistingFile( _
ByVal FilePath As String _
) As Boolean
' Return True if the file exists, False otherwise. This routine does not use the Dir technique as
' the Dir function resets any current Dir process.
'
' FilePath - Full path to the folder or file to be evaluated.
Dim Attributes As Long
On Error Resume Next
Attributes = GetAttr(FilePath)
ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0
Err.Clear
End Function
Kevin