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