MS Word中"最近使用文件"名的缩写算法求助.

[xDAVIDx]

小弟最近在写些程序,其中有一项是"保存最近使用的文件名",并在菜单中显示.当文件名较长时,就会碰到文件名部分缩写的问题,经过比较发现MS Word 2000的效果较好,但不知道其中的缩写算法是怎样的,故向各位请教,谢谢! :)

例如
"D:\David Software Studio\Graphic Format\GIF\GIF87a.txt" 显示为 "D:\David Software Studio\...\GIF\GIF87a"
"D:\GoSURF\whatsnew.rtf" 显示为 "D:\GoSURF\whatsnew"
"D:\David Software Studio\David Software Studio Documents\2006年高考考纲\2006年普通高校招生全国统一考试物理大纲.doc" 显示为 "D:\...\2006年高考考纲\2006年普通高校招生全国统一考试物理大纲"

[fuxc]

Option Explicit

Private Sub Command1_Click()
Debug.Print Get_ShotName("D:\David Software Studio\Graphic Format\GIF\GIF87a.txt")
Debug.Print Get_ShotName("D:\GoSURF\whatsnew.rtf")
Debug.Print Get_ShotName("D:\David Software Studio\David Software Studio Documents\2006年高考考纲\2006年普通高校招生全国统一考试物理大纲.doc")
End Sub

Private Function Get_ShotName(ByVal FileName As String) As String
Const MaxLength = 20 '允许的最长名字
Dim varFileSplit As Variant
Dim strName As String
Dim strFirstPath As String
Dim strLastPath As String
Dim strShotName As String
Dim intPlace As String

If Len(FileName) <= MaxLength Then
If FileName Like "*.???" Then
Get_ShotName = Left(FileName, Len(FileName) - 4)
Else
Get_ShotName = FileName
End If
Exit Function
End If

varFileSplit = Split(FileName, "\")

strName = varFileSplit(UBound(varFileSplit))
If strName Like "*.???" Then
strName = Left(strName, Len(strName) - 4)
End If
strFirstPath = varFileSplit(0) & "\"
strLastPath = "\" & varFileSplit(UBound(varFileSplit) - 1) & "\"

strShotName = "..." & strLastPath & strName
intPlace = 0
Do While (Len(strFirstPath) + Len(strShotName)) < MaxLength
intPlace = intPlace + 1
If intPlace >= UBound(varFileSplit) - 1 Then
Exit Do
End If

strFirstPath = strFirstPath & varFileSplit(intPlace) & "\"
Loop

If intPlace >= UBound(varFileSplit) - 2 Then
strShotName = Left(strFirstPath, Len(strFirstPath) - 1) & strLastPath & strName
Else
strShotName = strFirstPath & "..." & strLastPath & strName
End If

Get_ShotName = strShotName
End Function

[xDAVIDx]

问题已解决,谢谢fuxc(Michael(继续迷茫)) :)