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
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
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:\...
? 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,198
Downloads 418
CodeID
DB ID