Excel：vba实现批量修改文件名

 原文件名：

修改后的文件名：

Sub test()
'我这里只定义了一个cell,其余的我没有定义
Dim cell As Range

'清空 A 列中所有的内容,确保之前的数据不会影响到后续的操作
[a:a].Clear

'获取文件加的名字，这里的dir函数只返回一个文件名,即该文件下的第一个文件A.xlsx
Filename = Dir(ThisWorkbook.Path & "\")
MsgBox Filename

'定位到表的第一行
RowIndex = 1

'这个循环遍历当前工作簿所在文件夹中的所有文件名,直到没有文件或者文件名与当前工作簿相同(即排除当前文件)。
Do While Filename <> "" And Filename <> ThisWorkbook.Name
    '将获取的第一个文件的路径写入到a列的第一行
    Cells(RowIndex, 1) = ThisWorkbook.Path & "\" & Filename
    '行号加一，控制行号
    RowIndex = RowIndex + 1
    '获取下一个文件。Dir 函数的重复调用可以获取下一个文件
    Filename = Dir
Loop

'从a1单元格到a列的最后一个非空单元格复制到b列
Range("a1", Cells(Rows.Count, 1).End(xlUp)).Copy [b1]

'将b列中的A-公司替换成ABS公司等，可根据自己的需要进行替换
[b:b].Replace "A-公司", "ABS公司"
[b:b].Replace "B-公司", "BABALA公司"
[b:b].Replace "C-公司", "CVT公司"

'遍历 A 列中的每个单元格，并使用 Name 语句将该单元格代表的文件路径重命名为 B 列中对应单元格的新名称。
For Each cell In Range("a1", Cells(Rows.Count, 1).End(xlUp))
   Name cell As cell.Offset(0, 1)
Next cell
End Sub

 实现的过程如下：
第一步：

第二步：

第三步：

第四步：

最后的效果：