Saturday, 2 June 2018

VBA - Windows API - Code to shorten path to DOS 8.3 format

So just setting up some environment variables and irritatingly they misbehave if they have spaces, converting from a long windows path to a DOS 8.3 format can help even though spaces are legal in DOS 8.3. Anyway, we can write a program to call the relevant windows API. Here is some code adapted from a VBA book by Michael Schwimmer. I ran this for my Python path and I got no spaces so I'm happy.


Option Explicit

'* https://msdn.microsoft.com/en-us/library/windows/desktop/aa364989(v=vs.85).aspx
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _
        (ByVal lpszLongPath As String, _
        ByVal lpszShortPath As String, _
        ByVal cchBuffer As Long) As Long


Function ShortenPath(ByVal sLongPath As String) As String
    '* adapted from Michael Schwimmer
    '* https://www.amazon.de/Excel-VBA-Lerntest-Einstieg-Anspruchsvolle-Master/dp/3827325250/ref=sr_1_1?s=software

    Dim lShortLen As Long
    lShortLen = GetShortPathName(sLongPath, 0, 0)  '* first call it with null to get length only

    Dim sBuffer As String
    sBuffer = String(lShortLen, 0)
    
    lShortLen = GetShortPathName(sLongPath, sBuffer, lShortLen) '* now call it a buffer
    
    If lShortLen > 0 Then
        ShortenPath = Trim(Left$(sBuffer, lShortLen))
    End If

End Function

Sub TestShortenPath()
    Debug.Print ShortenPath("c:\Program Files\")
    Debug.Print ShortenPath("c:\Program Files (x86)\")
    Debug.Print ShortenPath("C:\Program Files (x86)\Microsoft Visual Studio\Shared\Python36_64")
End Sub

Running the procedure TestShortenPath() gives the following output

c:\PROGRA~1\
c:\PROGRA~2\
C:\PROGRA~2\MICROS~4\Shared\PYTHON~1

No comments:

Post a Comment