Tip of the Week #3: PathCompact

Wow, December was a very busy month for me, so I never got around to posting more than 1 tip of the week in December, so seems I am a bit behind. Anyways the inspiration and code for this tip comes from Ben Sacherich, a fellow member and co-founder of  “Professional Access Developers Unit”, my online networking user group.

 

The Problem

Sometimes we need to record the path of a file. The problem with filepaths is that they can vary by quite large amounts. You can have very short paths, such a “C:\Myfile.pdf” or you can have extremely long paths such as:

S:\DataStorage\Department of Health and Safety\Projects\Project 50014 Analysis of Health at the construction site on 5th avenue\001 Project Documentation\005 Reports\2013\December\Inspection Notice\2013-12-08 Inspection of site nr 5 – Handrail and staircase inspection.pdf

Now even here on my blog that takes up a few lines on my screen (at least at current resolution/blog template 🙂 ), and in my form:

Textbox not big enough to show contents

Textbox not big enough to show contents

On the other hand, if I make the textbox big enough to show the long path, it will look silly when I have a short path

Textbox looks way too large for its content

Textbox looks way too large for its content

The Solution

What we need is a way to reduce the path, while keeping the most essential parts of the path visible to the user. Now we could of course just write something out in VBA, but actually there is already a windows API function that can do this for us. Using a built in function can result in less control over the output (i.e. the function might reduce the path in a different way than we would have done with our own code) but on the other hand, it might provide a more similar approach between different applications if we are all using the same function. Besides, the already available function has been tested in various scenarios, and we just need to write a small wrapper to implement it in our application. In many cases it will make sense to have a wrapper function, because the wrapper function can make sure we weed out any bugs before they happen. For example this API will crash access if we pass it a negative number. Far better to have the wrapper make sure our number is positive before passing it.

First to make the API available we must declare it, and (of course) it must be done in the declaration section of a VBA module. It can be a form module as well, but in that case it would be private to the form, so it would be more useful to place it in a standard stand-alone module. You can see both the decleration of the API and the code below. The code is a modified version of the code found at Excel MVP Chip Pearsons site.

Private Declare Function PathCompactPathEx Lib "shlwapi.dll" Alias _
    "PathCompactPathExA" (ByVal pszOut As String, ByVal pszSrc As String, _
    ByVal cchMax As Long, ByVal dwFlags As Long) As Long

Public Function ShortenTextToChars(InputText As String, _
        NumberOfCharacters As Long) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShortenTextToChars
' This function returns a shortened version of the InputText parameter that is
' NumberOfCharacters in length. This function is primarily designed for use with
' fully-qualified file names. With a file name, the function will remove or truncate
' an element of the path (e.g., a folder name), replacing the removed text with the string
' "...". While this is intended for use with file names, it will work with any text string.
' When used on text that does not contain '\' characters, it typically just truncates the
' right side of InputText.
' Returns vbNullString is an error occurred.
'
''''' Originally found at Chip Pearsons website:
''''' http://www.cpearson.com/excel/sizestring.htm
''''' Reduced in size by TSC to match this blog post, but go look for the full version and more
''''' on Chips site. I also made some modifications to better match my "style" and a single bug fix.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim ResString As String
Dim Res As Long

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Test for NumberOfCharacters <= 3. If the InputText
' is 3 or fewer characters, PathCompactPathEx would replace the
' entire string with "...". We don't want that. Return the entire
' InputText.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Len(InputText) <= NumberOfCharacters Then
    ShortenTextToChars = InputText
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure we have a valid number of characters. If NumberOfCharacters
' is less than or equal to 0, PathCompactPathEx will crash the application.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If NumberOfCharacters <= 0 Then
    MsgBox "The NumberOfCharacters must be greater than 0."
    ShortenTextToChars = vbNullString
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Initialize the buffer. When PathCompactPathEx
' creates its string, it considers NumberOfCharacters
' to include room for the trailing null character. Thus
' the actual number of real characters it returns will be
' NumberOfCharacters-1. Thus, we allocate the string
' to NumberOfCharacters+2 = 1 because we want
' NumberOfCharacters (without the trailing null)
' returned, + 1 for trailing null.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
ResString = String$(NumberOfCharacters + 2, vbNullChar)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Shorten the text with PathCompactPathEx
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Res = PathCompactPathEx(ResString, InputText, NumberOfCharacters, 0&)
If Res = 0 Then
   ' An error occured. Chips version included a msgbox, and
   ' getting the correct API error number, but I prefer
   ' to just return #Error. This function is only for
   ' display, not for "use"
   ResString = "#Error"
End If

'''''''''''''''''''''''''''''''''''''''
' trim to get the charcters to the left
' of the vbNullChar character.
'''''''''''''''''''''''''''''''''''''''
ResString = TrimToNull(ResString)

'''''''''''''''''''''''''''''''''''''''
' return the result string
'''''''''''''''''''''''''''''''''''''''
ShortenTextToChars = ResString

End Function

Public Function TrimToNull(Text As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TrimToNull
' This function returns the portion of Text that is to the left of the vbNullChar
' character (same as Chr(0)). Typically, this function is used with strings
' populated by Windows API procedures. It is generally not used for
' native VB Strings.
' If vbNullChar is not found, the entire Text string is returned.
' Originally found at Chip Pearsons website:
' http://www.cpearson.com/excel/sizestring.htm
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Pos As Integer
    Pos = InStr(1, Text, vbNullChar)
    If Pos > 0 Then
        TrimToNull = Left(Text, Pos - 1)
    Else
        TrimToNull = Text
    End If

End Function

Now using this function, my textbox ends up looking like this:

Now the text will always fit

Now the text will always fit

In this way we have ensured that the text always fits the textbox. In the next tip of the week I will move forward with this example, and show how we can even allow manual edits to the field, while still having it fit in the box.

One comment on “Tip of the Week #3: PathCompact
  1. Crystal says:

    very nice! thanks, Smiley ~ Crystal

Leave a Reply to Crystal Cancel reply

Your email address will not be published. Required fields are marked *

*

This site uses Akismet to reduce spam. Learn how your comment data is processed.