用VBA实现选择文件夹中图片文件批量重命名

1、 效果展示：（图片原来的名称与重命名后的名称如下图）

2、代码 

Sub 重命名图片V2()

    Dim folderPath As String
    Dim file As String
    Dim Name0, Name1 As String
    Dim dialog As FileDialog
    Dim n
    
    Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    ' 打开文件夹选择对话框
    With dialog
        .Title = "选择文件夹"
        .AllowMultiSelect = False
        If .Show <> -1 Then
            MsgBox "未选择文件夹！"
            Exit Sub
        Else
            folderPath = .SelectedItems(1)
        End If
    End With
    
    ' 获取名称前缀后缀
    Name0 = "第"
    Name1 = "题图"
    
    ' 遍历文件夹中的所有文件
    file = Dir(folderPath & "\*.*")
    Do While file <> ""
        ' 如果是图片文件，则进行重命名
        If InStr(1, LCase(file), ".jpg") > 0 Or InStr(1, LCase(file), ".jpeg") > 0 Or InStr(1, LCase(file), ".png") > 0 Or InStr(1, LCase(file), ".gif") > 0 Or InStr(1, LCase(file), ".bmp") > 0 Then
            n = SplitString(file, ".")
            Name folderPath & "\" & file As folderPath & "\" & Name0 & n(0) & Name1 & "." & n(1)
        End If
        file = Dir
    Loop
    
    MsgBox "图片重命名完成！"
End Sub

Function SplitString(str, fen)
    Dim arr() As String
    
    arr = Split(str, fen)
    
    If UBound(arr) > 0 Then
        SplitString = Array(arr(0), arr(1))
    Else
        SplitString = Array("", "")
    End If
End Function