小小处女作：自定义函数(从完整路径中分离文件名/路径/尾缀名)

opel-wong

刚刚没事，写个自定义函数，从完整路径中分离出：尾缀名、不带尾缀的件名、带尾缀的文件名、不带文件名的路径'
水平有限，高手莫笑，不足之处，敬请指点，谢谢！
'

---

表达式：函数名(路径，参数)
路径＝指定的完整路径
参数：
         等于1，返回文件尾缀名
         等于2，返回不带尾缀文件名
         等于3，返回带尾缀的文件名
         等于4，返回不带文件名的路径
         其它，返回空值。

---

代码(放在公共模块中)

1. Public Function NameAndPath(ByVal FullPath As String, myNo As Byte) As String
   
2.     Dim Str1 As String: Str1 = InStrRev(FullPath, "")   ' 获取“\”的最后位置
   
3.     Dim Str2 As String: Str2 = InStrRev(FullPath, ".")   ' 获取“.”的最后位置
   
4.     If myNo = 1 Then    ' 第二参数为1
   
5.         NameAndPath = Mid(FullPath, Str2, Len(FullPath) - Str2 + 1)    ' 返回: 尾缀名
   
6.     ElseIf myNo = 2 Then    ' 第二参数为2
   
7.         NameAndPath = Mid(FullPath, Str1 + 1, Str2 - Str1 - 1)  ' 返回: 文件名
   
8.     ElseIf myNo = 3 Then    ' 第二参数为3
   
9.         NameAndPath = Mid(FullPath, Str1 + 1, Len(FullPath) - Str1)   ' 返回: 带后缀文件名
   
10.     ElseIf myNo = 4 Then    ' 第二参数为4
    
11.         NameAndPath = Mid(FullPath, 1, Str1)    ' 返回: 路径
    
12.     Else:
    
13.         NameAndPath = ""   ' 其它，返回空值
    
14.     End If
    
15. End Function

复制代码

未详加错误判断，不足之处，请跟贴指正，谢谢！

。

opel-wong

示例演示：

1. Sub aabb()  ' 指定文件
   
2.     Dim FullPath As String
   
3.     FullPath = "F:\FunshionMedia\红高粱-MP4\红高粱-第45集.mp4"
   
4. 
   
5.     MsgBox "文件尾缀名: " & NameAndPath(FullPath, 1) & vbCrLf & vbCrLf & _
   
6.            "仅文件名: " & NameAndPath(FullPath, 2) & vbCrLf & vbCrLf & _
   
7.            "带尾缀文件名: " & NameAndPath(FullPath, 3) & vbCrLf & vbCrLf & _
   
8.            "仅文件路径: " & NameAndPath(FullPath, 4), 64 + 0, "温馨提醒"
   
9. End Sub

复制代码

。

opel-wong

示例演示2：

1. Sub ccdd()  ' 选择文件
   
2.     Dim FullPath As Variant
   
3.     FullPath = Application.GetOpenFileName("任意文件 (*.*), *.*", , "随便选择一个文件")
   
4.     If FullPath = False Then Exit Sub
   
5.     MsgBox "文件尾缀名: " & NameAndPath(FullPath, 1) & vbCrLf & vbCrLf & _
   
6.            "仅文件名: " & NameAndPath(FullPath, 2) & vbCrLf & vbCrLf & _
   
7.            "带尾缀文件名: " & NameAndPath(FullPath, 3) & vbCrLf & vbCrLf & _
   
8.            "仅文件路径: " & NameAndPath(FullPath, 4), 64 + 0, "温馨提醒"
   
9. End Sub

复制代码

。

liulang0808

使用split吧
这个貌似挺管用的

opel-wong

liulang0808 发表于 2014-11-13 17:40
使用split吧
这个貌似挺管用的

也可以，按照你的建议重新写了一个，请测试，如下：

1. Public Function NameAndPath2(ByVal FullPath As String, myNo As Byte) As String
   
2.     Dim aa() As String: aa = Split(FullPath, "")
   
3.     Dim bb() As String: bb = Split(aa(UBound(aa)), ".")
   
4.     Dim cc() As String: cc = Split(FullPath, ".")
   
5.     If myNo = 1 Then    ' 第二参数为1
   
6.         NameAndPath2 = "." & cc(UBound(cc))   ' 返回: 尾缀名
   
7.     ElseIf myNo = 2 Then    ' 第二参数为2
   
8.         NameAndPath2 = bb(UBound(bb) - 1)   ' 返回: 文件名
   
9.     ElseIf myNo = 3 Then    ' 第二参数为3
   
10.         NameAndPath2 = aa(UBound(aa))    ' 返回: 带后缀文件名
    
11.     ElseIf myNo = 4 Then    ' 第二参数为4
    
12.         NameAndPath2 = cc(0) & ""   ' 返回: 路径
    
13.     Else:
    
14.         NameAndPath2 = ""
    
15.     End If
    
16. End Function

复制代码

调用如下：

1. Sub eeff()  ' 指定文件
   
2.     Dim FullPath As String
   
3.     FullPath = "F:\FunshionMedia\红高粱-MP4\红高粱-第45集.mp4"
   
4.     MsgBox "文件尾缀名: " & NameAndPath2(FullPath, 1) & vbCrLf & vbCrLf & _
   
5.            "仅文件名: " & NameAndPath2(FullPath, 2) & vbCrLf & vbCrLf & _
   
6.            "带尾缀文件名: " & NameAndPath2(FullPath, 3) & vbCrLf & vbCrLf & _
   
7.            "仅文件路径: " & NameAndPath2(FullPath, 4), 64 + 0, "温馨提醒"
   
8. End Sub

复制代码

1. Sub mmnn()  ' 选择文件
   
2.     Dim FullPath As Variant
   
3.     FullPath = Application.GetOpenFileName("任意文件 (*.*), *.*", , "随便选择一个文件")
   
4.     If FullPath = False Then Exit Sub
   
5.     MsgBox "文件尾缀名: " & NameAndPath2(FullPath, 1) & vbCrLf & vbCrLf & _
   
6.            "仅文件名: " & NameAndPath2(FullPath, 2) & vbCrLf & vbCrLf & _
   
7.            "带尾缀文件名: " & NameAndPath2(FullPath, 3) & vbCrLf & vbCrLf & _
   
8.            "仅文件路径: " & NameAndPath2(FullPath, 4), 64 + 0, "温馨提醒"
   
9. End Sub

复制代码

opel-wong

有人测试过吗，反馈一下结果，方便改进一下。谢谢。

yjh_27

1. 
   

复制代码

opel-wong

yjh_27 发表于 2014-11-14 09:33

什么意思？

一片空白，有没有代码或文字呀。

yjh_27

文件名中多个 “.” 或文件夹含“.” 将出错

1. Public Function NameAndPath2(ByVal FullPath As String, myNo As Byte) As String
   
2.     Dim aa() As String: aa = Split(FullPath, "")
   
3.     Dim bb() As String: bb = Split(aa(UBound(aa)), ".")
   
4.     If myNo = 1 Then    ' 第二参数为1
   
5.         NameAndPath2 = "." & bb(UBound(bb))   ' 返回: 尾缀名
   
6.     ElseIf myNo = 2 Then    ' 第二参数为2
   
7.         ReDim Preserve bb((UBound(bb)) - 1)
   
8.         NameAndPath2 = jion(bb, ".")  ' 返回: 文件名
   
9.     ElseIf myNo = 3 Then    ' 第二参数为3
   
10.         NameAndPath2 = aa(UBound(aa))    ' 返回: 带后缀文件名
    
11.     ElseIf myNo = 4 Then    ' 第二参数为4
    
12.         If UBound(aa) = 0 Then
    
13.             NameAndPath2 = ""
    
14.         Else
    
15.             ReDim Preserve aa((UBound(aa)) - 1)
    
16.             NameAndPath2 = jion(aa, "")    ' 返回: 路径
    
17.         End If
    
18.     Else:
    
19.         NameAndPath2 = ""
    
20.     End If
    
21. End Function
    

复制代码

opel-wong

yjh_27 发表于 2014-11-14 11:09
文件名中多个 “.” 或文件夹含“.” 将出错

也不是很严谨, 测试发现, 路径返回的不正确.

FullPath = "F:\Funshion.Media\红高.粱-MP4\红高粱-第45集.mp4"


Public Function NameAndPath2(ByVal FullPath As String, myNo As Byte) As String
    Dim aa() As String: aa = Split(FullPath, "\")
    Dim bb() As String: bb = Split(aa(UBound(aa)), ".")
    If myNo = 1 Then    ' 第二参数为1
        NameAndPath2 = "." & bb(UBound(bb))   ' 返回: 尾缀名
    ElseIf myNo = 2 Then    ' 第二参数为2
        ReDim Preserve bb((UBound(bb)) - 1)
        NameAndPath2 = VBA.Join(bb, ".")  ' 返回: 文件名
    ElseIf myNo = 3 Then    ' 第二参数为3
        NameAndPath2 = aa(UBound(aa))    ' 返回: 带后缀文件名
    ElseIf myNo = 4 Then    ' 第二参数为4
        If UBound(aa) = 0 Then
            NameAndPath2 = ""
        Else
            ReDim Preserve aa((UBound(aa)) - 1)
            NameAndPath2 = VBA.Join(bb, "\")    ' 返回: 路径
        End If
    Else:
        NameAndPath2 = ""
    End If
End Function