标题: [原创][分享]获取路径信息函数 [打印本页] 作者: wang1999 时间: 2015-11-22 09:07 标题: [原创][分享]获取路径信息函数 最近在学习VS2010的自动化与扩展.顺手写了几个路径信息的函数
'获取文件名
Function GetFileName(Path As String) As String
Dim lPos As Long
lPos = InStrRev(Path, "\")
If lPos Then GetFileName = Mid$(Path, lPos + 1)
End Function
'获取目录名
Function GetDirName(Path As String) As String
Dim lPos As Long
lPos = InStrRev(Path, "\")
If lPos Then GetDirName = Mid$(Path, 1, lPos)
End Function
'获取扩展名
Function GetExtension(Path As String) As String
Dim lPos1 As Long, lPos2 As Long
lPos1 = InStrRev(Path, "\")
lPos2 = InStrRev(Path, ".")
'防止没有扩展名的文件
If lPos1 < lPos2 And lPos1 > 0 Then GetExtension = Mid$(Path, lPos2 + 1)
End Function
'获取根目录
Function GetPathRoot(Path As String) As String
Dim lPos As Long
If Left$(Path, 2) = "\\" Then '处理网络路径
lPos = InStr(3, Path, "\")
If lPos Then GetPathRoot = Mid$(Path, 1, lPos)
Else
lPos = InStr(1, Path, "\")
If lPos Then GetPathRoot = Left$(Path, lPos)
End If
End Function
'获取文件名, 不带扩展名
Function GetFileNameNoExt(Path As String) As String
Dim lPos1 As Long, lPos2 As Long, strRet As String
lPos1 = InStrRev(Path, "\")
If lPos1 < 1 Then Exit Function
lPos2 = InStrRev(Path, ".")
If lPos1 < lPos2 Then '文件名存在扩展名
GetFileNameNoExt = Mid$(Path, lPos1 + 1, lPos2 - lPos1 - 1)
Else '文件名没有扩展名
GetFileNameNoExt = Mid$(Path, lPos1 + 1)
End If
End Function
Sub Path_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 GetFileName(strPath)
Debug.Print GetDirName(strPath)
Debug.Print GetExtension(strPath)
Debug.Print GetPathRoot(strPath)
Debug.Print GetFileNameNoExt(strPath)
End Sub
有了上面的基本够用了.
下面是整合的函数
作者: tmtony 时间: 2015-11-22 09:19
wang1999 发表于 2015-11-22 09:07
最近在学习VS2010的自动化与扩展.顺手写了几个路径信息的函数
'获取文件名
Function GetFileName(Path As ...
