Excel's fullname property with OneDrive

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 in

Answer 1

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:

1. A URL associated with the user's OneDrive
2. A URL associated with the user's OneDrive for Business
3. 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 2

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 3

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 4

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 5

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 6

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.