使用VBA批量重命名文件

1、打开Excel工作表，按下键盘上面的【Alt+F11】组合键打开VBA编辑器。

2、在VBA编辑器的菜单栏上边点击【插入】、【模块】。

3、在模块的代码窗口里边输入以下VBA程序代码：

Sub ChangeFileName()

Dim fs, fo, fi, fil, str, na, ty, k, k1, k2

On Error Resume Next                                 '忽略运行过程中可能出现的错误

Set fs = CreateObject("Scripting.FileSystemObject")  '创建并返回对计算机系统文件的访问

Set fo = fs.Getfolder("D:\ABC\")                     '定义文件夹，“ABC”为D盘下边的文件夹

Set fi = fo.Files                                    '定义文件夹下边所有文件集

For Each fil In fi                     '获取文件夹里面所有的文件

  na = fil.Name                        '获取文件名称

  k1 = 0                               '每执行1行则初始化一次

  k2 = 0

    Do

     k2 = k2 + 1

     k = k1                            'k用来存放上次k1的值

     k1 = InStr(k1 + 1, na, ".")       'k1为“.”所在的位置

      If k1 = 0 And k <> 0 Then         '如果"."为文件后缀名的点

       str = Mid(na, 1, k - 1)         '截取文件名（不含文件类型）

       ty = Right(na, Len(na) - k + 1) '从右侧截文件类型

       Exit Do                         '退出Do循环

      Else

      If k1 = 0 And k = 0 Then          '如果没有文件后缀名，则

       str = na

       ty = ""

       Exit Do

      End If

      End If

      If k2 = 1000 Then                 '如果do循环超过1000次则强行退出

       Exit Do

      End If

     Loop

  fil.Name = str & "_2018-07-14" & ty   '对文件重命名

Next

MsgBox "文件重命名完成，请不要再运行程序！"

End Sub

4、先对文件夹里边的文件进行备份，在VBA编辑器界面上按下【F5】键运行程序，将会看到文件夹里边的文件已经全部被重命名。

5、程序、思路解读：

（1）通过VBA获取的文件名是带有后缀名的（通常看到的文件名不带后缀名，那是已知的文件后缀名被隐藏了），借助Instr函数判断“.”所在的位置，使用Mid和Right函数截取文件名和后缀名，再根据重命名需要把它们凑合到一起。

（2）“If k1 = 0 And k <> 0 Then”说明已经找到了后缀名所在的位置（即：上次已经找到了后缀名的点位置k，再从k开始找时已经找不着），之后就可以执行截操作了。

（3）使用Do循环时，应当避免死循环的出现（出现死循环时Excel将会无响应），此时就创造性的添加一个条件（如：k2=k2+1，k2大于1000就强制退出Do循环），以免软件卡死。

（4）Len是获取字符串长度的函数。

6、此VBA程序代码也可以写入vbs脚本程序里边，然后通过脚本程序重命名文件。

（1）新建一个文本文档，然后把“Sub ChangeFileName()……End Sub”里边的代码复制到文本文档里边。（即：除了“Sub ChangeFileName()”和“End Sub”）

（2）把文本文档的后缀名（.txt）改成（.vbs），文件名可自拟，再双击该vbs脚本程序即可重命名。（如果已经使用VBA重命名，就不要运行vbs脚本程序重命名）