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

zhangdabai1

已于 2023-12-09 11:58:50 修改

阅读量1.1k

点赞数 1

文章标签：算法

于 2023-10-21 09:24:56 首次发布

本文链接：https://blog.csdn.net/zhangdabai1/article/details/133957469

版权

该篇文章介绍了使用VBA编写的一个Sub过程，用于在指定文件夹中批量重命名图片文件，仅保留特定前缀和后缀。作者展示了代码片段和操作流程。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

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