本文于2023年2月26日首发于本人同名公众号：Excel活学活用，敬请关注！
前些天在听一个课程的MP3，它每一课有2个文件，大概是这样子“001-朗读.MP3" 和“001-讲解.MP3"，在播放列表中，这两个文件的顺序是讲解在前，朗读在后，应该是先朗读再讲解，那么解决办法是把文件改名，比如改成这样“001-1朗读.MP3" 和“001-2讲解.MP3"，但文件太多，一个一个手工去改实在太累，有没有其他办法呢？
经过一番沉思，感觉可以有！
废话不多说，直接上代码：
在sheet1里，插入3个命令按钮，并输入代码：
Private Sub CmdClear_Click()
ActiveSheet.Cells.ClearContents
End?Sub
Private Sub CommandButton1_Click()
Call OldNames
?End?Sub
Private Sub CommandButton2_Click()
Call ChangeNames
End?Sub在模块1里：
Dim arrFiles()
Dim iPath As String
Sub?OldNames()
iPath = PathSelected()
If iPath = "" Then
MsgBox "文件路径异常，请重新读取文件！"
Exit Sub
End If
arrFiles = GetSubFiles(iPath)
Sheet1.Range("A:A").Clear
Sheet1.Range("A3").Resize(UBound(arrFiles) + 1, 1) = Application.WorksheetFunction.Transpose(arrFiles)
Sheet1.Range("A1") = "文件夹："
Sheet1.Range("B1") = iPath
Sheet1.Range("A2") = "原文件名"
Sheet1.Range("B2") = "新文件名"
End Sub
Sub ChangeNames()
Dim iRow
Dim oFSO
Dim oFolder
Dim oFile
Dim OldName$
Set oFSO = CreateObject("Scripting.FileSystemObject")
iRow = Sheet1.UsedRange.Rows.Count
arrFiles = Sheet1.Range("A3:B" & iRow)
'检查新文件名有没有空白的
For i = 1 To UBound(arrFiles, 1)
If arrFiles(i, 1) <> "" Then
If arrFiles(i, 2) = "" Then
MsgBox "第" & i & "行有空文件名，请重新检查修改！"
??????????????????Exit?Sub
End If
End If
?????Next
??????'开始改名
For i = 1 To UBound(arrFiles, 1)
If arrFiles(i, 1) <> "" Then
OldName = Sheet1.Range("B1") & "\" & arrFiles(i, 1)
If oFSO.fileexists(OldName) Then
Set oFile = oFSO.GetFile(OldName)
????????????????If?oFile.Name?<>?arrFiles(i,?2)?Then??
oFile.Name = arrFiles(i, 2)
End If
End If
End If
Next
MsgBox "批量改名成功"
End Sub
Function GetSubFiles(iPath As String)
Dim FSO As Object, SFolder, fl
Dim arr()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SFolder = FSO.GetFolder(iPath)
For Each fl In SFolder.Files
i = i + 1
ReDim Preserve arr(i - 1)
arr(i - 1) = fl.Name
??????Next
GetSubFiles = arr
End?Function
Function PathSelected()
With Application.FileDialog(msoFileDialogFolderPicker)
?????????If?.Show?=?-1 Then ??????????????????????'FileDialog 对象的 Show 方法显示对话框，并且返回?-1（如果按 OK）和?0（如果按 Cancel）。
PathSelected = .SelectedItems(1)
Else
Exit Function
??????????End?If
End With
End?Function简单解释一下代码：
基本思路：把要修改名称的文件名读取到sheet1表的A列，然后在B列根据需要对应修改成想要的文件名，这里可以充分利用Excel的查找替换、公式函数等功能，方便地形成想要的文件名。然后运行一段代码，逐个把A列的文件名改名为B列的文件名。
如何获取要修改的文件名？
这里假定是在一个文件夹下进行操作，那么，我们可以做两件事，第一，先取得文件夹路径，然后再取得该文件夹下所有文件的名称。这里我们定义了两个自定义函数，Function PathSelected(); Function GetSubFiles(iPath As String)，实现需求的功能。
取得文件名后，同时也把路径记录下来，填在“B1"单元格，便于查看，防止搞错了，这里还是要提醒一下，此操作不可恢复，操作前请看仔细，重要文件要做好备份！！！当然，要想实现恢复的功能也不是什么难事，把新旧文件名对照表复制保存到另外一张表上，要恢复的时候，把文件名对调一下，执行批量改名即可，这里不再多说，各位自行发挥。
接下来，就是把对应的新文件名处理好，点击“批量改名”按钮，大功告成。
另外，两个自定义函数（取得文件夹路径、取得文件夹下所有文件名）用处广泛，可以保存备用，实际上我在写这玩意的时候，就是从别的文件里Copy过来的，啥都没改，直接使用上了。
好，今天就到这，示例文件下载地址附在文后，感兴趣的自取不谢。
祝各位一切安好，如果是初学VBA的同学，我们可以多多交流。
链接：
https://pan.baidu.com/s/1IrKmoEiLvlfkw3qXMCJ8hg?pwd=kk7q
提取码：kk7q
本文于2023年2月26日首发于本人同名公众号：Excel活学活用，敬请关注！