ARTICLE · 1293565
Excel-VBA-批量重命名文件夹内文件:读取表格新旧文件名,批量修改/图片
Excel-VBA-批量重命名文件夹内文件:读取表格新旧文件名,批量修改/图片 经常收到一堆图片、报表，文件名杂乱，需要统一改成单号、客户名称。一个个右键重命名效率极低，很容易改错、改错一个就要返工。 这个宏用Excel表格维护【旧文件名、新文件名】清单，VBA循环读取，自动去磁盘批量改名，支持图片、Excel、PDF等各类文件。 ✅ 功能说明 1. 在表格维护旧名称、目标新名称 2. 支持Excel、图片、PDF等任意格式文件 3. 自动判断源文件是否存在，不存在提示跳过 4. 重命名冲突（同名）自动跳过，不会覆盖 5. 可以先运行预览模式，只输出日志，不真实修改 完整宏如下可以复制直接使用 Sub 根据表格清单批量重命名文件() Dim ws As Worksheet Dim folderPath As String Dim lastRow As Long, i As Long Dim oldName As String, newName As String Dim oldFullPath As String, newFullPath As String Set ws = ActiveSheet '====参数修改==== folderPath = "D:\待改名文件\" '文件存放目录，末尾带\ 'A列：旧文件名（带后缀，如 001.jpg） B列：新文件名（带后缀） '================ lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row If lastRow < 2 Then MsgBox "没有改名清单！", vbExclamation Exit Sub End If Application.ScreenUpdating = False For i = 2 To lastRow oldName = Trim(ws.Cells(i, "A").Value) newName = Trim(ws.Cells(i, "B").Value) If oldName = "" Or newName = "" Then GoTo NextRow oldFullPath = folderPath & oldName newFullPath = folderPath & newName '判断原文件是否存在 If Dir(oldFullPath) = "" Then ws.Cells(i, "C").Value = "失败：源文件不存在" GoTo NextRow End If '判断新名字是否已经存在，防止覆盖 If Dir(newFullPath) <> "" Then ws.Cells(i, "C").Value = "失败：新文件名已存在" GoTo NextRow End If Name oldFullPath As newFullPath ws.Cells(i, "C").Value = "✅改名成功" NextRow: Next i MsgBox "批量改名执行结束，C列查看结果！", vbInformation Application.ScreenUpdating = True End Sub 使用说明 表格规划： A列表头：旧文件名（必须带上后缀：123.xlsx / a.png） B列表头：新文件名（同样带上后缀） C列：自动输出运行结果，成功或者失败原因 注意事项： 1. 后缀一定要一致！不要漏写 .xlsx .png，否则直接报错 2. 优先复制一份原文件备份再跑宏，防止改错无法恢复 3. 文件名不要包含 \ / : * ? " < > | 4. 如果想要只预览、不实际改名：注释掉 Name oldFullPath As newFullPath 这一行，只看判断结果 持续分享职场干货🌹专业vba开发，关注收藏不迷路。 Excel-VBA月报报表挨个发邮件太耗时间！VBA读取表格，自动填正文、带上附件一键推送 Excel-VBA数据太脏不用手改！一键全自动清洗：去空格、清乱码、统一日期、多条件去重 VBA多条件查找，返回全部匹配多条记录（一对多查询） VBA一键按条件自动提取数据（文员、生产统计专用） 领导要的数据对比表，一套公式搞定🤝
