Need a ShortenPathname(LongPathName)

CAlexander
CAlexander used Ask the Experts™
on
I need something to format a pathname of a file,
to fit in a label if the pathname is to long

The ShortPathName would be similiar to the
Windows Explorer's File - Properties on long filepaths

Example:
 
  From
C:\Program Files\Microsoft Visual Studio\Common\MSDev98\Bin\MSDEV.EXE

   To
C:\Program Files\Microsoft Visual Studio\Comm...\Bin\MSDEV.EXE

Although the above result is 62 chars long,
I would need a max of 42 chars in my label

'
'---- Test Code ----
'

Private Const MaxCharWidth = 42
'
Private Sub onFilePathChanged ()
    ' ...
    lblFilePath.Caption = ShortPathName(Filepath)
    '...
End Sub
'
Private Function ShortPathName _
            (ByVal FilePath as String) As String
   
    Dim ShortPath As String
   
    If MaxCharWidth <= Len(FilePath) Then
        ' Filepath has acceptable size
        ShortPath = FilePath
    Else
        '
        ' Need to figure this out
        ShortPath = ""
    End If

    ' Return ShortPath
    ShortPathName = ShortPath

End Sub
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
VK

Commented:
Hello,

how should be the rules of "shortening" ?
VK

Commented:
How would you shorten this:

c:\A1234567890123456789012345678901234567890123456789012\Test.exe

v.k.
Head of Software Services
Commented:
How about this:

Private Function ShortPathName(ByVal Path As String, Optional ByVal MaxLen As Integer = 42) As String
    ShortPathName = Right(Path, Len(Path) - InStrRev(Path, "\", InStrRev(Path, "\") - 1) + 1)
    Dim intLeft As Integer
    Do
        intLeft = InStr(intLeft + 1, Path, "\")
    Loop Until intLeft > MaxLen - Len(ShortPathName) - 2 Or intLeft = 0
    ShortPathName = Left(Path, InStrRev(Path, "\", intLeft - 1)) & ".." & ShortPathName
End Function
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

VK

Commented:
Or try this if you want to split with equal lengths:

Public Function ShortDisplay(ByVal T As String, Max As Long) As String
    Dim S As String
    Dim i As Long
   
    T = Trim(T)
    i = Max \ 2
   
    If Len(T) > Max Then
        S = Left(T, i) & "..." & Right(T, i)
    End If
    ShortDisplay = S
End Function
VK

Commented:
found a small error in my code above :-)

Public Function ShortDisplay(ByVal T As String, Max As Long) As String
    Dim S As String
    Dim i As Long
   
    T = Trim(T)
    i = Max \ 2
   
    If Len(T) > Max Then
        S = Left(T, i) & "..." & Right(T, Max - i)
    End If
    ShortDisplay = S
End Function

Author

Commented:
both are very nice,
however, neither attempt (which i didn't clarify before) to at least show the amount of directories its replaced.

such as:
c:\directory1\directory_two\directory3\directory_four\file.txt
changed to:
c:\directory1\directory_...\..\..\file.txt

and the extremely long directories that don't fit:
c:\directory1\...\...\...\...\...\file.txt

I hope im being clear, because im not really sure how to explain it appropriatly.

If not, I won't waste ur time, and will accept one of your attempts.

try this.


Declare Function GetShortPathName Lib "kernel32" _
      Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
      ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long


       
Public Function GetShortName(ByVal sLongFileName As String) As String
    Dim lRetVal As Long, sShortPathName As String, iLen As Integer
    sShortPathName = Space(255)
    iLen = Len(sShortPathName)
    lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
    GetShortName = Left(sShortPathName, lRetVal)
End Function



Regards

Jayesh

Author

Commented:
Was more toward what i was looking for, with just a few modifications that I can figure out.
Thanks!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial