Excel:VBA批量修改文件名
Dim filePath As Variant '定义filepath为变量
Dim obj As Object '定义obj为变量对象
Dim fld, ff, gg '定义fld,ff,gg为变量
Sub getpath()
Range("A2:C1000").ClearContents '清空A2:C1000列
On Error Resume Next
Dim shell As Variant
Set shell = CreateObject("Shell.Application")
Set filePath = shell.BrowseForFolder(&O0, "选择文件夹", &H1 + &H10, "") '获取文件夹路径地址
Set shell = Nothing
If filePath Is Nothing Then '检测是否获得有效路径,如取消直接跳出程序
Exit Sub
Else
gg = filePath.Items.Item.Path
End If
Set obj = CreateObject("Scripting.FileSystemObject") '定义变量
Set fld = obj.getfolder(gg) '获取路径
For Each ff In fld.Files '遍历文件夹里文件
m = m + 1
Cells(m + 1, 1) = ff.Name
Cells(m + 1, 2) = "-------"
Cells(m + 1, 3) = Right(ff.Name, Len(ff.Name) - 2)
Next
End Sub
Sub renamefile()
x = InputBox("例如:5月", "要改为几月")
On Error Resume Next
If [a2] = "" Then MsgBox "请点击第一步": Exit Sub
For Each ff In fld.Files '遍历文件夹里的所有文件
m = m + 1
ff.Name = x & Cells(m + 1, 3) '将实际文件名改成目录中C列的对应文件名
Next
MsgBox "改名已完成,请检查", vbOKOnly
End Sub