求EXCEL VBA批量修改文件名的代码示例

Question

如题，那位前辈有现成代码请提供给我参考下，谢谢！

Answer 1

办公室有个批量更改照片的 占个位置 明天上班再贴 半夜懒重写了。

目标：为学员照相 导入电脑并批量修改为学号加姓名

1、首先建立一个EXCEL表 其中第一个工作薄名称为照相顺序表 如下图

Sub 照片重命名()

If MsgBox("程序将重命名与本工作薄同目录下的所有照片文件，确认这样做么？", vbYesNo) <> 6 Then

Exit Sub

End If

Dim oldname As String '旧文件名变量oldname

Dim newname As String '新文件名变量newname

Dim photopath As String '路径变量photopath

Dim nophoto As String '错误提示变量nophoto

Dim i As Integer '循环变量i

photopath = ThisWorkbook.Path '为要修改的文件名路径复制为当前excel文件的路径

For i = 2 To Worksheets("照相顺序表").Range("a65536").End(xlUp).Row '开始循环 从“照相顺序表”工作薄的a2单元格开始

'为新文件名变量赋值为路径变量& \ & 照相顺序表工作薄中的a2&b2单元格内容加上扩展名.jpg

newname = photopath & "\" & Worksheets("照相顺序表").Cells(i, 1).Text & Worksheets("照相顺序表").Cells(i, 2).Text & ".jpg"

'为旧文件名变量赋值为路径变量& \ & 照相顺序表工作薄中的c2单元格内容&扩展名.jpg

oldname = photopath & "\" & Worksheets("照相顺序表").Cells(i, 3).Text & ".jpg"

'判断旧文件名是否在当前目录存在

If Dir(oldname) <> "" Then

Name oldname As newname '存在则改名

Else

nophoto = nophoto & Chr(10) & oldname‘不存在则将其赋值给错误提示变量并以回车分割累加

End If

Next i

If nophoto <> "" Then

MsgBox nophoto & Chr(10) & "图片不存在" ’存在错误提示则弹出错误提示框

End If

End Sub 

备注是刚添加的 希望有所帮助，另外求分谢谢。

Answer 2

你看看这个，可以直接用的
Sub 批量更名()
Dim mypath$, myfile$, newname$, firstname$, rn As Range, t As Boolean
On Error Resume Next
mypath = InputBox("请输入更名文件的文件夹", "输入路径", "C:\文件夹1")
myfile = Dir(mypath & "\" & "*.jpg")
Set rn = Range("C1:C" & [C65536].End(xlUp).Row)
Do While myfile <> "" And firstname <> myfile '电脑写磁盘的动作远比程序运行速度慢所以多加了一个条件能避免改过名的文件再次被更名
Set c = rn.Find(Split(myfile, ".")(0), lookat:=xlWhole)
If Not c Is Nothing Then
oldname = mypath & "\" & myfile
newname = c.Offset(0, -2).Value & c.Offset(0, -1).Value & ".jpg"
Name mypath & "\" & myfile As mypath & "\" & newname
If t = False Then firstname = newname: t = True
End If
myfile = Dir
Loop
End Sub

Answer 3

你要修改什么格式的文件？？