图号分离函数

一直有朋友问文件名分割宏，特地做了个我认为的万能函数，
以下代码可以分割各种格式的文件名，将其分割为需要的字符，只是函数，需要进行再开发！！！


Dim swApp As SldWorks.SldWorks
Dim swPart As ModelDoc2

Sub main()
    Set swApp = Application.SldWorks
    Set swPart = swApp.ActiveDoc

    '获取文件名
    Dim swPartName As String
    swPartName = GetFileNameWithoutExtension(swPart.GetPathName)
    Debug.Print swPartName

    '定义公式(详见函数说明)
    Dim PropertyValue As String
    PropertyValue = "/filename, ,0,0"

    '根据公式获得分割的关键字
    Debug.Print ReplaceFileName(swPartName, PropertyValue)

    '写入文件属性
    '此处省略

End Sub

'获取无扩展文件名
'引用 Microsoft Scripting Runtime
Public Function GetFileNameWithoutExtension(strFullPath As String) As String
    Dim fso As FileSystemObject
    Set fso = CreateObject("scripting.filesystemobject")
    GetFileNameWithoutExtension = fso.GetBaseName(strFullPath)

End Function

'函数用法
'关键字 /filename 表示文件名（无扩展名）
'格式 /filename,分隔符,取位,是否默认，以","分割
'分隔符：为文件中需要分位的关键字，如 空格，-，_等
'取位：以分隔符为单位，在分隔符上的位置，以0开始
'是否默认：0，如文件名中无分隔符时，不输出字符；1，如文件名中无分隔符时，输出字符（忽略分隔符）

'|符号后为替换数组以","分割，单数为替换前字符，双数为为替换后字符
'示例：
'文件名：  AAAA-BBB_CCC DDD

'格式1：   /filename  输出：AAAA-BBB_CCC DDD
'格式2：   /filename|CCC,EEE,DDD,FFF  输出：AAAA-BBB_EEE FFF
'格式3：   /filename,-,0,0  输出：AAAA
'格式4：   /filename,_,1,0|CCC,EEE  输出：EEE DDD
'格式5：   /filename,_,2,0  输出：空
'格式6：   /filename, ,0,0  输出：AAAA-BBB_CCC
'格式6：   /filename,+,1,0  输出：空
'格式6：   /filename,+,1,1  输出：AAAA-BBB_CCC DDD

Public Function ReplaceFileName(FileName As String, FildValue As String) As String
    If InStr(FildValue, "/filename") = 0 Then Exit Function
    Dim ReplaceValue As String
    Dim tmp_KeyWord As String

    '有替换选项
    If InStr(FildValue, "|") > 0 Then
    '替换数组
        ReplaceValue = Split(FildValue, "|")(1)
        '新文件名
        FildValue = Split(FildValue, "|")(0)
    End If

    '有分割选项
    If InStr(FildValue, ",") > 0 Then
        '分隔符
        Dim Division As String
        Division = Split(FildValue, ",")(1)
        '取号
        Dim ItemIndex As Integer
        ItemIndex = Split(FildValue, ",")(2)
        '关键
        Dim ItemKey As Boolean
        ItemKey = Split(FildValue, ",")(3)

        '文件名中有分隔符
        If InStr(FileName, Division) > 0 Then
            '获取最大分割单位
            Dim iMaxItemIndex As Integer
            iMaxItemIndex = UBound(Split(FileName, Division))

            If ItemIndex <= iMaxItemIndex Then
                tmp_KeyWord = Split(FileName, Division)(ItemIndex)
            Else
                tmp_KeyWord = ""
            End If
        Else
            '如果关键为True
            If ItemKey Then tmp_KeyWord = FileName
        End If
    Else
        tmp_KeyWord = FileName
    End If

    '替换关键字数组
    If ReplaceValue <> "" Then
        For i = 0 To UBound(Split(ReplaceValue, ",")) Step 2
            tmp_KeyWord = Replace(tmp_KeyWord, Split(ReplaceValue, ",")(i), Split(ReplaceValue, ",")(i + 1))
        Next
    End If
    ReplaceFileName = tmp_KeyWord
End Function

有看懂的吗

图号与文件名之间带横线的能分离吗？下载试用一下，先感谢楼主……

未分离成功，提示见图……

未分离成功，提示见图……

图号和名称在一起也很好的,没必要这么纠结

很好的学习资源!多谢分享！！！