The OneDrive Nightmare Continues: ThisWorkbook.Path and ThisWorkbook.FullName

All the work contributed here by the participants is very valuable to us amateurs who follow along to make use of the code to get a usable value in VBA for "Thisworkbook". I use VBA only with OneDrive. May I ask: is there a "best" version of the code -- shortest and most efficient -- proposed in the discussion that would be sufficient to use just with OneDrive, not being concerned with the other repositories?

I'm a little confused regarding your file locations.

You said that when the text files are NOT in a Sharepoint folder you can't find them from VBA code, but if they ARE in a Sharepoint folder you can find them, correct?

The location of the document containing the VBA code that processes the text files has nothing to do with determining where the text files are and opening them - unless those text files are in a location relative to the document containing the VBA code.

The code I provided in this thread only translates a Sharepoint path starting with "http://" into the mirrored local path on the machine running the VBA code. This is required when running VBA code from a document opened from a mirrored Sharepoint location where the Path property is the "http://" form of the document's path versus the local path, which is virtually useless in VBA.

Kevin

UPDATE ....

My statement in my last post was incorrect ...

"My scripts seem to work exactly the same way, the difference is that it now recognizes the Sharepoint paths (since the file was executed from the SharePoint folder)."

After further inspection of my script results, it did NOT recognize the Sharepoint path (where the excel macro file was executed from), only the paths on my local PC.

However, it appears that the "Workbooks("xxxxxy.xlsm").Close SaveChanges:=True" statement seems to work and the opened macro file is saved to the SharePoint folder, where it was opened from.

This is exactly the same as clicking the save-file icon at the top, right above the Excel Ribbon menu.

Nevertheless, I unfortunately need to manually save files to SharePoint until such time that I can figure out how to do it programmatically.

Cheers!

Pat

Hi Kevin,

I found a different way to accomplish what I need done.

Instead of running the excel macro file from my PC, I have moved the file to a Sharepoint folder and then I use the "Open in app" option from the 'Open' drop-down menu.

My scripts seem to work exactly the same way, the difference is that it now recognizes the Sharepoint paths (since the file was executed from the SharePoint folder).

Unfortunately, my organization's security protocols do not allow me to set the 'Open in app' option as a default. Nor does it allow me to 'Map a folder location' as a shortcut on my PC.

I can live with this for now.

Anyway, I see that your code has helped others resolve the SharePoint file access issues ... Nice work!

Pat

Sorry, my mistake. The code works like a charm in Word too, replacing the string "workbook" with "document", and removing all debugging (as it was written to log stuff in an Excel worksheet), including removing "Dim Calculation As XlCalculation" and removing the LogWorksheet argument from FileExists (which I somehow had messed up before).

Here's the code:

Option Explicit

'-------------------------------------------------------------------------------
'
'           Function OneDriveLocalFilePath( ...
'
'           Fix that .path doesn't work when the file is in a OneDrive folder.
'
'Code adapted from forum post by Kevin Zvorek 2024-07-02
'https://answers.microsoft.com/en-us/msoffice/forum/all/the-onedrive-nightmare-continues-thisworkbookpath/3350ec2c-e75b-4bfd-acb7-d6ce71bd9c51
'-------------------------------------------------------------------------------
Public Function OneDriveLocalFilePath( _
        Optional ByRef OneDriveFilePath As String, _
        Optional ByVal ReturnFolderPathOnly As Boolean, _
        Optional ByVal ReturnEmptyIfFileNotFound As Boolean _
    ) As String

' Kevin Zvorek 2024-07-02
'
' Returns the local file path given a URL to a file stored in a OneDrive or Sharepoint folder. For
' some reason the Excel document 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
'   Thisdocument.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.

    Const RegistryPath As String = "HKEY_CURRENT_USER\SOFTWARE\SyncEngines\Providers\OneDrive\"

    Dim ScreenUpdating As Boolean
    Dim EnableEvents As Boolean
    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 LibraryType As String
    Dim URLNameSpaceExtended As String
    Dim LocalPartialPath As String
    Dim PartialPathRootDirectory As String
    Dim LocalPartialPathWithFirstFolder As String
    Dim LocalPartialPathWithoutFirstFolder As String
    Dim Pass As Long
    Dim ExistsCount As Long
    Dim EntryCount As Long

    ' Default to the full name property of Thisdocument
    If Len(OneDriveFilePath) = 0 Then
        OneDriveFilePath = ThisDocument.FullName
    End If

    ' 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

            ' 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

                    ' Each key has three values of interest:
                    '
                    '   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

                    On Error Resume Next
                    CID = WScript.RegRead(RegistryPath & RegistryKey & "\CID")
                    MountPoint = WScript.RegRead(RegistryPath & RegistryKey & "\MountPoint")
                    URLNamespace = WScript.RegRead(RegistryPath & RegistryKey & "\URLNamespace")
                    LibraryType = WScript.RegRead(RegistryPath & RegistryKey & "\LibraryType")
                    On Error GoTo 0

                    EntryCount = EntryCount + 1

                    ' Remove any trailing slash from the URL name space
                    If Right(URLNamespace, 1) = "/" Then
                        URLNamespace = Left(URLNamespace, Len(URLNamespace) - 1)
                    End If

                    ' Determine the extended URL name space which may or may not include the CID
                    If Len(CID) = 0 Then
                        URLNameSpaceExtended = URLNamespace
                    Else
                        URLNameSpaceExtended = URLNamespace & "/" & CID
                        If Left(OneDriveFilePath, Len(URLNameSpaceExtended)) <> URLNameSpaceExtended Then
                            URLNameSpaceExtended = URLNamespace
                        End If
                    End If

                    ' Looking for a local file path only if the base of the path being evaluated matches the extended URL name space
                    If Left(OneDriveFilePath, Len(URLNameSpaceExtended)) = URLNameSpaceExtended Then

                        LocalPartialPath = Mid(OneDriveFilePath, Len(URLNameSpaceExtended) + 2)

                        ' It's not always clear if the first directory in the partial path is used locally, it may be a firectory only in the cloud to distinguish directories shared by others
                        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

                            ' Build two local partial paths: one with the first folder after the mount point, and the second without the first folder after the mount point
                            LocalPartialPathWithFirstFolder = Replace(Replace(Mid(OneDriveFilePath, Len(URLNameSpaceExtended) + 2), "/", "\"), "%20", Space(1))
                            LocalPartialPathWithoutFirstFolder = Mid(LocalPartialPathWithFirstFolder, InStr(LocalPartialPathWithFirstFolder, "\") + 1)
                            If LocalPartialPathWithFirstFolder = LocalPartialPathWithoutFirstFolder Then
                                LocalPartialPathWithFirstFolder = vbNullString
                            End If

                            If OneDriveLocalFilePath_FileExists(MountPoint & "\" & LocalPartialPathWithoutFirstFolder, ConfirmedFilePath, ExistsCount) Then Exit For
                            If Len(LocalPartialPathWithFirstFolder) > 0 Then
                                If OneDriveLocalFilePath_FileExists(MountPoint & "\" & LocalPartialPathWithFirstFolder, ConfirmedFilePath, ExistsCount) Then Exit For
                            End If

                        End If

                    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
                End If

            Else

                Result = OneDriveFilePath

            End If

            If ExistsCount < 2 Then Exit For

        Next Pass

    Else
        ' The path is not a URL so return it as-is
        Result = OneDriveFilePath
    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 = Result

End Function

Private Function OneDriveLocalFilePath_FileExists( _
        ByRef ProposedFilePath As String, _
        ByRef ConfirmedFilePath As String, _
        ByRef ExistsCount As Long _
    ) As Boolean

' Kevin Zvorek 2024-07-02

' Tests if file path exists. Internal use only.

    If ProposedFilePath = ConfirmedFilePath Then Exit Function

    If ExistingFile(ProposedFilePath) Then
        ConfirmedFilePath = ProposedFilePath
        ExistsCount = ExistsCount + 1
    End If

End Function

Public Function ExistingFile( _
        ByVal FilePath As String _
    ) As Boolean

' Kevin Zvorek 2024-07-02

' 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
'-------------------------------------------------------------------------------