告别手动重命名!这个Excel小工具,批量加前缀/后缀一键搞定

还在一个一个文件改名字？复制粘贴到手酸？今天分享一个自制的VBA小工具，帮你轻松实现批量重命名，支持添加前缀、后缀，还带实时预览和双击打开功能。

🎯 适用场景

照片批量命名（如：2025春节_001.jpg）
工作报表统一加前缀（如：月度报告_销售数据.xlsx）
整理下载的文件，统一加后缀说明
任何需要批量修改文件名的时候

🛠️ 工具界面

主要包含：

文件夹选择
前缀/后缀输入框
文件列表（显示原名 → 新名预览）
执行重命名、清空重置、关闭按钮

✨ 核心功能

选择文件夹 – 一键选取目标文件夹
添加前缀/后缀 – 输入任意文字，实时预览新文件名
文件列表展示 – 原文件名 + 新文件名并排显示
双击打开文件 – 在列表中双击即可打开文件，方便确认
智能重命名 – 自动保留扩展名，避免重复文件名覆盖
操作反馈 – 显示成功/失败数量，安全可靠

🔧 核心代码解析（关键部分）

1. 加载文件列表并预览新文件名

Private Sub LoadFileList()    lbFiles.Clear    Dim fso As Object, folder As Object, file As Object    Set fso = CreateObject("Scripting.FileSystemObject")    Set folder = fso.GetFolder(selectedFolder)    fileCount = 0    For Each file In folder.Files        fileCount = fileCount + 1        ReDim Preserve fileList(1 To fileCount)        fileList(fileCount) = file.Name        lbFiles.AddItem file.Name        lbFiles.List(fileCount - 1, 1) = GetNewFileName(file.Name)    Next fileEnd Sub

2. 根据前缀/后缀生成新文件名（自动保留扩展名）

Private Function GetNewFileName(oldName As String) As String    Dim prefix As String, suffix As String, ext As String, baseName As String    prefix = txtPrefix.Text    suffix = txtSuffix.Text    ext = GetExtension(oldName)      ' 提取扩展名 .jpg/.xlsx 等    baseName = GetBaseName(oldName)  ' 提取文件名主体    GetNewFileName = prefix & baseName & suffix & extEnd Function

3. 实时更新预览（输入前缀/后缀时自动刷新）

Private Sub txtPrefix_Change()    UpdatePreviewEnd SubPrivate Sub txtSuffix_Change()    UpdatePreviewEnd SubPrivate Sub UpdatePreview()    If fileCount = 0 Then Exit Sub    Dim i As Integer    For i = 1 To fileCount        lbFiles.List(i - 1, 1) = GetNewFileName(fileList(i))    Next iEnd Sub

4. 执行重命名（带错误处理）

Private Sub btnRename_Click()    ' ... 省略路径检查 ...    Dim fso As Object, successCount As Integer, failCount As Integer    Set fso = CreateObject("Scripting.FileSystemObject")    For i = 1 To fileCount        oldPath = selectedFolder & "\" & fileList(i)        newPath = selectedFolder & "\" & GetNewFileName(fileList(i))        If oldName <> newName Then            If Not fso.FileExists(newPath) Then                Name oldPath As newPath                successCount = successCount + 1            Else                failCount = failCount + 1            End If        End If    Next i    MsgBox "重命名完成！成功：" & successCount & " 失败：" & failCountEnd Sub

5. 双击打开文件（快速查看内容）

Private Sub lbFiles_DblClick(ByVal Cancel As MSForms.ReturnBoolean)    If lbFiles.ListIndex = -1 Then Exit Sub    Dim fileName As String    fileName = lbFiles.List(lbFiles.ListIndex, 1)  ' 新文件名优先    If fileName = "" Then fileName = lbFiles.List(lbFiles.ListIndex, 0)    ThisWorkbook.FollowHyperlink selectedFolder & "\" & fileNameEnd Sub

📦 获取完整代码

由于篇幅限制，上文只展示了核心逻辑。完整窗体代码包含所有控件绘制、边界判断、清空重置等功能。

👉 关注公众号 【Excel每日一学】 ，回复关键词 “206051400” 即可获取完整示例文件。

💡 小贴士

支持任意文件类型（照片、Word、Excel、PDF等）
如果新文件名已存在，工具会跳过该文件，避免覆盖
前缀/后缀支持中英文、数字、符号（注意不能包含 \ / : * ? " < > | 等非法字符）
建议先在测试文件夹中试用，确认无误后再操作重要文件

📢 结语

批量重命名是日常办公的刚需，有了这个VBA小工具，再也不用装第三方软件。打开Excel，几行代码就能搞定。

如果你觉得有用，欢迎点赞、在看、转发支持！

有任何问题欢迎评论区留言交流