ShortenDir

Shorten a long Dir by adding ... in the middle to make it fit in small boxes
Found online a while back, needs some work maybe, but a good start.
Can be modified to be used with URLs as well

CodeFunctionName
What is this?

Public

Tested

Imported
Function ShortenDir(FullDir, MaxLength)
Dim i, LblLen, StringLen As Integer
Dim TempString As String
TempString = FullDir
LblLen = MaxLength
If Len(TempString) <= LblLen Then
ShortenDir = TempString
Exit Function
End If
LblLen = LblLen - 6
For i = Len(TempString) - LblLen To Len(TempString)
If Mid$(TempString, i, 1) = "\" Then Exit For
Next
ShortenDir = Left$(TempString, 3) & "..." & Right$(TempString, Len(TempString) - (i - 1))
End Function

FullDir, MaxLength

MyPath = "D:\My\Dropbox\CameraQosmioTV\Sites.Add2ANmarSystems\FeedBacks"
? ShortenDir(MyPath, 70)
D:\My\Dropbox\CameraQosmioTV\Sites.Add2ANmarSystems\FeedBacks
? ShortenDir(MyPath, 60)
D:\...\CameraQosmioTV\Sites.Add2ANmarSystems\FeedBacks
? ShortenDir(MyPath, 50)
D:\...\Sites.Add2ANmarSystems\FeedBacks
? ShortenDir(MyPath, 40)
D:\...\Sites.Add2ANmarSystems\FeedBacks
? ShortenDir(MyPath, 30)
D:\...\FeedBacks
? ShortenDir(MyPath, 20)
D:\...

Views 1,190

Downloads 414

CodeID
DB ID