Ok, I’ll admit it, expanding a Short format File or Directory Path is a niche ask, but I recently required this ability and so I thought I’d share my solution in case anyone else was faced with this need.
Where did my need come from exactly?
Well, I was setting a Reference dynamically and the technique utilized a registry value which was in Short format. I then wanted to validate, but couldn’t because the Reference Path had been expanded to Long format. Thus, I needed that same ability so I could compare apples with apples.
The Solution
Once again, to simplify and optimize my code I’m using SHOV (Self-Healing Object Variables), so if you’re not already familiar with it, you should first review:
'---------------------------------------------------------------------------------------
' Procedure : FSO_ExpandShortPath
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return the Expanded version of a Short format Path/File
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> None required
' Early Binding -> Microsoft Scripting Runtime & see SHOV requirements
' Dependencies: FSO and Shell SHOVs (https://www.devhut.net/self-healing-object-variables/)
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sInput : Path or Fully Qualified Filename and Path to Expand
'
' Usage:
' ~~~~~~
'? FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15\EXCEL.EXE")
' Returns -> C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE
'? FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15")
' Returns -> C:\Program Files (x86)\Microsoft Office\Office15
'? FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15\")
' Returns -> C:\Program Files (x86)\Microsoft Office\Office15
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2022-10-18 Initial Release
'---------------------------------------------------------------------------------------
Public Function FSO_ExpandShortPath(ByVal sInput As String) As String
On Error GoTo Error_Handler
#If FSO_EarlyBind = True Then
Dim oFile As Scripting.File
#Else
Dim oFile As Object
#End If
If oFSO.FileExists(sInput) Then
Set oFile = oFSO.GetFile(sInput)
FSO_ExpandShortPath = oShell.Namespace(oFile.ParentFolder.Path). _
ParseName(oFile.Name).Path
ElseIf oFSO.FolderExists(sInput) Then
FSO_ExpandShortPath = oShell.Namespace(CStr(sInput)).Self.Path
End If
Error_Handler_Exit:
On Error Resume Next
If Not oFile Is Nothing Then Set oFile = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_ExpandShortPath" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Usage Examples
With this in hand now, we can easily expand both paths or fully qualified files by simply doing:
Expanding a Full Qualified File
We can call it by simply do
? FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15\EXCEL.EXE")
which will return
C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE
Or pass it to a variable like:
Dim sFile As String
sFile = FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15\EXCEL.EXE")
Expanding a Path
Similarly, for paths we can do:
? FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15")
or
? FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15\")
which will return:
C:\Program Files (x86)\Microsoft Office\Office15
Or pass it to a variable like:
Dim sPath As String
sPath = FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15")
Without The Use Of SHOVs
I’ve been asked before how to use such functions without SHOVs, and it’s not hard to do. You simply need to add back all the declarations, initialization and cleanup that SHOVs provide automatically. Long story short, you would end up with something like:
'---------------------------------------------------------------------------------------
' Procedure : FSO_ExpandShortPath
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return the Expanded version of a Short format Path/File
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> none required
' Early Binding -> Microsoft Scripting Runtime
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sInput : Path or Fully Qualified Filename and Path to Expand
'
' Usage:
' ~~~~~~
'? FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15\EXCEL.EXE")
' Returns -> C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE
'? FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15")
' Returns -> C:\Program Files (x86)\Microsoft Office\Office15
'? FSO_ExpandShortPath("C:\PROGRA~2\MICROS~1\Office15\")
' Returns -> C:\Program Files (x86)\Microsoft Office\Office15
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2022-10-18 Initial Release
'---------------------------------------------------------------------------------------
Public Function FSO_ExpandShortPath(ByVal sInput As String) As String
On Error GoTo Error_Handler
#Const FSO_EarlyBind = False
#If FSO_EarlyBind = True Then
Dim oFSO As Scripting.FileSystemObject
Dim oFile As Scripting.File
Set oFSO = New FileSystemObject
#Else
Dim oFSO As Object
Dim oFile As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
#End If
If oFSO.FileExists(sInput) Then
Set oFile = oFSO.GetFile(sInput)
FSO_ExpandShortPath = CreateObject("Shell.Application"). _
Namespace(oFile.ParentFolder.Path). _
ParseName(oFile.Name).Path
ElseIf oFSO.FolderExists(sInput) Then
FSO_ExpandShortPath = CreateObject("Shell.Application"). _
Namespace(CStr(sInput)).Self.Path
End If
Error_Handler_Exit:
On Error Resume Next
If Not oFile Is Nothing Then Set oFile = Nothing
If Not oFSO Is Nothing Then Set oFSO = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_ExpandShortPath" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
So as you can see, SHOVs do in fact simplify coding, ‘a little bit’ as we’ve gone from a 30 line function to a 40 line function now, and let us not forget potential performance benefits that SHOVs offer.
A Few Ending Remarks
The beauty here is one function can handle both files and folders.
Furthermore, the Function:
- Uses no APIs, so no bitness considerations, so it work in both 32 and 64-bit installations
- Uses no application specific methods/properties/…, so it can be used in any VBA application (Excel, Outlook, Word, …)
- Can be used in either Early or Late Binding
- Is optimized since it uses SHOVs (if you use the SHOV version obviously!)
An Alternate Solution To The Problem
I quickly wanted to point out that, yes, there is at least 1 other approach that could have been used to solve my initial comparison problem. I could have just as easily passed the Reference file to FSO, returned the FSO’s File Object ShortPath property and compared that against the Short Path I had retrieved from the Registry.
But where’s the fun in that?! This way I got to create a new function, one that I have personally never come across anywhere else before!
All kidding aside though, as with all things in programming, there are numerous ways to solve problems, so think outside the box, play around with ideas and code, test, try and look at things from the opposite end, most importantly have fun!
Resources on the Subject
