Binaryworld - GetShortenedFileName - Make a filename shorter using ellipses ... [ VB -> Files & Folder ]

' return a file path not longer than the number of character
' specified in the 2nd argument
'
' If necessary, it replaces directory names with ellipsises
'
' Author: Fred Block
'     CuzWare Systems
'     E-mail: fblock@cuzware.com
'     Web Site: http://www.cuzware.com

Function GetShortenedFileName(ByVal strFilePath As String, _
  ByVal maxLength As Long) As String
  Dim astrTemp() As String
  Dim lngCount As Long
  Dim strTemp As String
  Dim index As Long

  ' if the path is shorter than the max allowed length, just return it
  If Len(strFilePath) <= maxLength Then
    GetShortenedFileName = strFilePath
  Else
    ' split the path in its constituent dirs
    astrTemp() = Split(strFilePath, "\")
    lngCount = UBound(astrTemp)

    ' lets replace each part with ellipsis, until the length is OK
    ' but never substitute drive and file name
    For index = 1 To lngCount - 1
      astrTemp(index) = "..."
      ' rebuild the result
      GetShortenedFileName = Join(astrTemp, "\")
      If Len(GetShortenedFileName) <= maxLength Then Exit For
    Next
  End If

End Function