本文于2023年2月26日首发于本人同名公众号：Excel活学活用，敬请关注！

前些天在听一个课程的MP3，它每一课有2个文件，大概是这样子“001-朗读.MP3" 和“001-讲解.MP3"，在播放列表中，这两个文件的顺序是讲解在前，朗读在后，应该是先朗读再讲解，那么解决办法是把文件改名，比如改成这样“001-1朗读.MP3" 和“001-2讲解.MP3"，但文件太多，一个一个手工去改实在太累，有没有其他办法呢？

经过一番沉思，感觉可以有！

废话不多说，直接上代码：

在sheet1里，插入3个命令按钮，并输入代码：

Private Sub CmdClear_Click()    ActiveSheet.Cells.ClearContentsEnd SubPrivate Sub CommandButton1_Click()    Call OldNames End SubPrivate Sub CommandButton2_Click()    Call ChangeNamesEnd Sub

在模块1里：

Dim arrFiles()Dim iPath As StringSub 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 SubSub 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 SubFunction 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 = arrEnd FunctionFunction PathSelected()    With Application.FileDialog(msoFileDialogFolderPicker)         If .Show = -1 Then                       'FileDialog 对象的 Show 方法显示对话框，并且返回 -1（如果按 OK）和 0（如果按 Cancel）。            PathSelected = .SelectedItems(1)        Else            Exit Function          End If    End WithEnd Function

简单解释一下代码：

基本思路：把要修改名称的文件名读取到sheet1表的A列，然后在B列根据需要对应修改成想要的文件名，这里可以充分利用Excel的查找替换、公式函数等功能，方便地形成想要的文件名。然后运行一段代码，逐个把A列的文件名改名为B列的文件名。

如何获取要修改的文件名？

这里假定是在一个文件夹下进行操作，那么，我们可以做两件事，第一，先取得文件夹路径，然后再取得该文件夹下所有文件的名称。这里我们定义了两个自定义函数，Function PathSelected(); Function GetSubFiles(iPath As String)，实现需求的功能。

取得文件名后，同时也把路径记录下来，填在“B1"单元格，便于查看，防止搞错了，这里还是要提醒一下，此操作不可恢复，操作前请看仔细，重要文件要做好备份！！！当然，要想实现恢复的功能也不是什么难事，把新旧文件名对照表复制保存到另外一张表上，要恢复的时候，把文件名对调一下，执行批量改名即可，这里不再多说，各位自行发挥。

接下来，就是把对应的新文件名处理好，点击“批量改名”按钮，大功告成。

另外，两个自定义函数（取得文件夹路径、取得文件夹下所有文件名）用处广泛，可以保存备用，实际上我在写这玩意的时候，就是从别的文件里Copy过来的，啥都没改，直接使用上了。

好，今天就到这，示例文件下载地址附在文后，感兴趣的自取不谢。

祝各位一切安好，如果是初学VBA的同学，我们可以多多交流。

链接：

提取码：kk7q

本文于2023年2月26日首发于本人同名公众号：Excel活学活用，敬请关注！