2007-10-25 22:57:14 Kenny

取得長檔名(傳回絕對路徑)

來源:CWW

重點在於:
1.GetFullPathName 傳回一個絕對路徑的名稱,但是它不保證該File/Directory存不存在
  而且,如果傳入的是8.3檔名,那該Function的絕對路徑也是8.3格式
2.Dir 指令會傳回該 檔案/目錄 的長檔名

二者搭配便可取得長檔名的絕對路徑

呼叫例子:
  
 Debug.Print toLongName("C:\PROGRA~1\ACCESS~1\MSPAINT.EXE")
 Debug.Print toLongName("C:\PROGRAM FILES\ACCESS~1")
 Debug.Print toLongName("..\MyFile")


Public Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA"  _
        (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, _
         ByVal lpFilePart As String) As Long

Public Function toLongName(ByVal FileName As String) As String
Dim TokenStr As New Collection, pos As Integer
Dim FullPathName As String, I As Long
Dim ptstr As String
ptstr = String(256, 0)
FullPathName = String(256, 0)

'先取得 檔案/目錄 的完整目錄名稱
I = GetFullPathName(FileName, 256, FullPathName, ptstr)
FullPathName = Left(FullPathName, InStr(1, FullPathName, Chr(0)) - 1)
'如果該 檔案/目錄不存在則返回
If Len(Dir(FullPathName, vbDirectory + vbNormal + vbHidden + vbSystem + vbReadOnly)) = 0 Then
   toLongName = ""
   Exit Function
End If
'取得FullPtahName各個部份,如 C:\DIRECT~1\FILENAME
'將變成 C:  DIRECT~1  FILENAME三個字串存在TokenStr的Collection中
Do While True
   pos = InStr(1, FullPathName, "\")
   If pos <> 0 Then
      TokenStr.Add Left(FullPathName, pos - 1)
      FullPathName = Mid(FullPathName, pos + 1)
   Else
      TokenStr.Add FullPathName
      Exit Do
   End If
Loop
'取出各個Token,並以Dir指令取得 檔案/目錄 的長檔名
toLongName = TokenStr(1) + "\" '第一個一定是Driver名稱(如 c:)
Dim LongName As String
For I = 2 To TokenStr.Count
    'Dir("C:\Progra~1") 會傳回 "Program Files"
    LongName = Dir(toLongName + TokenStr(I), vbNormal + vbSystem + vbArchive + vbDirectory + vbHidden)
    toLongName = toLongName + LongName + "\"
Next
toLongName = Left(toLongName, Len(toLongName) - 1)
End Function