I was trying to help out in a forum discussion in which a user was needing to retrieve the old DOS short path format of a path. As with all things VBA, there are multiple ways to do this and one of the more common approaches is to use the GetShortPathName API. Now there is nothing wrong with the use of APIs, but at the same time, they can unnecessarily complicate things, as you need to worry about bitness, code can become complex… so normally, if you truly don’t need them, you are best to use alternative solution.
Anyways, I thought I’d show a simpler solution using FSO (File System Object). Below was my answer to the question
'---------------------------------------------------------------------------------------
' Procedure : GetShortPath
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return the short path version of a path
' 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: Early Binding -> reference to the 'Microsoft Scripting Runtime' library
' Late Binding -> none required
' REF : https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/getfolder-method
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sPath : Full path to retrieve the short path version of
'
' Usage:
' ~~~~~~
' GetShortPath("C:\temp\Help Desk_Updater")
' Returns -> C:\temp\HELPDE~1
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2020-07-05 Initial Release, Forum Help
'---------------------------------------------------------------------------------------
Function GetShortPath(ByVal sPath As String) As String
' #Const EarlyBind = True 'Use Early Binding, Req. Reference Library
#Const EarlyBind = False 'Use Late Binding
#If EarlyBind = True Then
'Requires a reference the 'Microsoft Scripting Runtime' library
Dim oFSO As Scripting.FileSystemObject
Dim oFldr As Scripting.Folder
#Else
Dim oFSO As Object
Dim oFldr As Object
#End If
On Error GoTo Error_Handler
If Right(sPath, 1) <> "\" Then sPath = sPath & "\" 'Ensure we have a trailing \
#If EarlyBind = True Then
Set oFSO = New FileSystemObject
#Else
Set oFSO = CreateObject("Scripting.FileSystemObject")
#End If
Set oFldr = oFSO.GetFolder(sPath)
GetShortPath = oFldr.ShortPath
Error_Handler_Exit:
On Error Resume Next
If Not oFldr Is Nothing Then Set oFldr = Nothing
If Not oFSO Is Nothing Then Set oFSO = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetShortPath" & 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
You can even simplify the above to a single line if you truly wish to:
'---------------------------------------------------------------------------------------
' Procedure : GetShortPath
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return the short path version of a path
' 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
' REF : https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/getfolder-method
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sPath : Full path to retrieve the short path version of
'
' Usage:
' ~~~~~~
' GetShortPath("C:\temp\Help Desk_Updater")
' Returns -> C:\temp\HELPDE~1
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2020-07-05 Initial Release
'---------------------------------------------------------------------------------------
Function GetShortPath(ByVal sPath As String) As String
On Error GoTo Error_Handler
If Right(sPath, 1) <> "\" Then sPath = sPath & "\" 'Ensure we have a trailing \
GetShortPath = CreateObject("Scripting.FileSystemObject").GetFolder(sPath).ShortPath
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetShortPath" & 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
So at the end of the day, a single line of code:
CreateObject("Scripting.FileSystemObject").GetFolder("YourFullPathWithATrialing\").ShortPath
can replace APIs and subsequent function calls and be just as effective.
