|
首先新建EXCEL工作簿，在一个工作表中按照如下输入设置：
一： A2单元格输入文字：文件夹路径；C2单元格输入文字：读取文件名后，请设置好新文件名后再执行文件重命名操作 二： A3:C3合并单元格 三： A4:C4合并单元格，并输入分割线（主要考虑视觉效果及VBA运行排除空行） 四： A5单元格输入文字：遍历文件夹下所有文件名 五： B5单元格输入文字：文件类型 六： C5单元格输入文字：设置新文件名（默认为原名） 七： 按照下图步骤，将文末的代码复制写入模块中： 八： 选择A1单元格，在开发工具选项卡中，选择插入菜单中的按钮（窗体控件），制作三个按钮控件，设置文字为初始化（选择指定名为“初始化”的宏），读取文件名（选择指定名为“读取文件名”的宏），文件改名（选择指定名为“文件重命名”的宏）。 九： 开始自由改名啦，体验一下自己的劳动成果吧。解放你的双手，大大提高效率。 如果喜欢，请点赞并关注一下。请把此文章分享给你的朋友们。
Sub 读取文件名() ActiveSheet.Rows("6:10000").Select Selection.Delete Shift:=xlUp ActiveSheet.Range("A6").Select With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False If .Show = -1 Then [a3] = .SelectedItems(1) End If End With Dim myPath$, i% myPath = Dir([a3] & "\*.*") Do While myPath <>> i = i + 1 Cells(i + 5, 1) = Left(myPath, InStrRev(myPath, ".") - 1) Cells(i + 5, 2) = Mid(myPath, InStrRev(myPath, "."), 9) Cells(i + 5, 3) = Left(myPath, InStrRev(myPath, ".") - 1) myPath = Dir Loop End Sub Sub 文件重命名() filePath = [a3] On Error Resume Next n = 6 While Not IsEmpty(Cells(n, 1)) oldName = Cells(n, 1) & Cells(n, 2) newNname = Cells(n, 3) & Cells(n, 2) If Dir(filePath & "\" & oldName) = "" Then MsgBox "请重新读取文件名！" Exit Sub ElseIf n <> Name filePath & "\" & oldName As filePath & "\" & newNname ElseIf n = ActiveSheet.Range("A" & Rows.Count).End(3).Row Then Name filePath & "\" & oldName As filePath & "\" & newNname MsgBox "重命名成功" ActiveWorkbook.Save Exit Sub End If n = n + 1 Wend End Sub Sub 初始化() Range("a3").Select Selection.ClearContents ActiveSheet.Rows("6:10000").Select Selection.Delete Shift:=xlUp ActiveSheet.Range("A6").Select ActiveWorkbook.Save End Sub
| 
