[原创][分享]获取路径信息函数

wang1999

最近在学习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

wang1999 发表于 2015-11-22 09:07
最近在学习VS2010的自动化与扩展.顺手写了几个路径信息的函数
'获取文件名
Function GetFileName(Path As ...

赞一个
来自: 微社区

shenzhenzch

谢谢分享！

764300778

eeee

hwhwenha01

好东西来自: Android客户端

hwhwenha01

要是天有真好！来自: Android客户端

coolleaf20

挺好的。

风中漫步

谢谢分享

zhuyiwen

赞一个{:soso_e179:}

WFH6898

赞一个