'-----------------------------------------------------------------
'Function
: GetPathInfor
'Purpose : 获得路径中指定的信息
'Input :
' [in] : Path
(String) 文件的全路径
' [in] : Infor (Long) 需要获得的信息: 0, 文件名; 1, 目录名; 2, 扩展名; 3,
根目录; 4, 不带扩展名的文件名
'Return : (String) 返回指定的路径信息; 当 Path 中没有指定的信息时,
返回零长度的字符串.
'DemoCode : GetPathInfor_Test
'Usage : None
'Refer :
调用API:None；公用函数:None；私有函数:None；
'Compatib : VB, VBA, VBS; Win32,
Win64；已测试：Access2003SP3+Win7x32SP1
'Modified : V1.0 坚果
2015-11-20 Infor:创建
' V1.1 坚果 2015-11-22 进度:10%
Infor:修订信息
'-----------------------------------------------------------------
Function
GetPathInfor(Path As String, Infor As Long) As String
Dim lPosPath As
Long, lPosExt As Long
If Infor <> 3 Then lPosPath = InStrRev(Path,
"\")
Select Case Infor
Case 0 '文件名
GetPathInfor = Mid$(Path, lPosPath + 1)
Case 1 '目录名
GetPathInfor = Mid$(Path, 1, lPosPath)
Case 2 '扩展名
lPosExt = InStrRev(Path, ".")
'防止没有扩展名的文件
If lPosPath
< lPosExt Then GetPathInfor = Mid$(Path, lPosExt + 1)
Case 3
'根目录
If Left$(Path, 2) = "\\" Then '处理网络路径
lPosPath = InStr(3, Path, "\")
If lPosPath Then GetPathInfor =
Mid$(Path, 1, lPosPath)
Else
lPosPath = InStr(1, Path,
"\")
If lPosPath Then GetPathInfor = Left$(Path, lPosPath)
End If
Case 4 '不带扩展名的文件名
lPosExt =
InStrRev(Path, ".")
If lPosPath < lPosExt Then '文件名存在扩展名
GetPathInfor = Mid$(Path, lPosPath + 1, lPosExt - lPosPath - 1)
Else '无扩展名的文件名
GetPathInfor = Mid$(Path, lPosPath +
1)
End If
End Select
End Function
Private Sub
GetPathInfor_Test()
Dim strPath As String
' strPath =
"C:\dir1\dir2\foo.txt" '正常目录
strPath = "C:\dt01\dir.2\footxt"
'没有扩展名, 路径中含有"."符号
' strPath = "\\dt01\dir.2\footxt" '网络路径1
'
strPath = "\\192.168.1.101\dir.2\foo.txt" '网络路径2
Debug.Print "文件名",
GetPathInfor(strPath, 0)
Debug.Print "目录名", GetPathInfor(strPath, 1)
Debug.Print "扩展名", GetPathInfor(strPath, 2)
Debug.Print "根目录",
GetPathInfor(strPath, 3)
Debug.Print "不带扩展名的文件名", GetPathInfor(strPath,
4)
End Sub
