用EXCEL数据批量改文件名我有一个文
写了一段，未调试，有兴趣可以试试看，有兴趣可以自己增加 记录表格中未匹配目录中文件的记录 以及 目录中文件未匹配表格中记录的文件 部分，时间关系，没有完成
Sub CHG_Name()
Dim fPath As String
Dim fs, f, fi, ex, xx
Dim check_file As Boolean
Dim rg As Range
Dim Tmp As Collection
Dim Temp As Collection
Set Tmp = New Collection
Set Temp = New Collection
fPath = ActiveWorkbook。 ...全部
写了一段，未调试，有兴趣可以试试看，有兴趣可以自己增加 记录表格中未匹配目录中文件的记录 以及 目录中文件未匹配表格中记录的文件 部分，时间关系，没有完成
Sub CHG_Name()
Dim fPath As String
Dim fs, f, fi, ex, xx
Dim check_file As Boolean
Dim rg As Range
Dim Tmp As Collection
Dim Temp As Collection
Set Tmp = New Collection
Set Temp = New Collection
fPath = ActiveWorkbook。
Path
Set rg = Range("A1") '如果第一行为表头，A1修改为A2
Do While rg <> ""
On Error Resume Next '没有重名删除这句话
Tmp。
Add rg。Value & rg。Offset(0, 1), CStr(rg。Value & rg。Offset(0, 1))
Temp。Add rg。Offset(0, 2)。Value & "_" & rg。
Offset(0, 3)。Value & "_" & rg。Offset(0, 4)。Value, CStr(rg。Value & rg。Offset(0, 1))
On Error GoTo 0
Set rg = rg。
Offset(1, 0)
Loop
Set fs = CreateObject("Scripting。FileSystemObject")
Set f = fs。GetFolder(fPath)
For Each ex In Tmp
For Each fi In f。
Files
check_file = False
If ex = tbasename(fi) Then
If fs。FileExists(fPath & "\" & Temp(ex) & "。
" & fs。GetExtensionName(fi)) And fs。FileExists(fPath & "\" & ex & "。" & fs。GetExtensionName(fi)) Then
If MsgBox("目标文件 " & Temp(ex) & "。
" & fs。GetExtensionName(fi) & " 存在，是否覆盖？", vbYesNo) = vbYes Then
check_file = True
Else
check_file = False
End If
End If '如果很多要修改为的文件名字已经存在，多多点点鼠标，统一处理可能麻烦
pyfile fi, fPath & "\" & Temp(ex) & "。
" & fs。GetExtensionName(fi), check_file
fs。DeleteFile fi, True '如果不需要删除原文件，删除此行
End If
Next
Next
End Sub
。
收起
