[VBA] EXCEL 批次修改指定檔名

用途，將左列目標檔名，更名為右列檔名

我是拿來做型號替換拉

原本都用批次檔寫的，想說麻煩直接用VBA寫好了

參考了之前買的書寫出來的，是本好書唷 ISBN -978-986-201-026-6

路徑要自己填喔!

檔案下載

 Download

書裡面說要開啟 Microsoft Scripting Runtime ，從工具→引用項目勾選就可以了

取代完成後 第三欄會出現 是否更名完成，找不到檔案就會出現 No

另外我沒有針對 唯讀以及 系統鎖定檔做判斷，所以有可能會掛掉，檢查一下是否為唯讀或是系統檔就好

提供一下原始碼

Option Explicit
Sub fileRename()
Dim myRng1 As Range
Dim myRng2 As Range
Dim myRng As Range
Dim OldName, NewName
Dim I As Integer
Dim filePach As String
'=====================================
Dim myFso As Scripting.FileSystemObject '檔案確認
Set myFso = New Scripting.FileSystemObject
'=====================================
Dim Wok As Worksheet
Set Wok = Worksheets("重新命名列表")
filePach = Wok.Cells(1, 2) '路徑
If Right(filePach, 1) <> "\" Then filePach = filePach & "\"
'=====================================
Set myRng1 = Cells(Rows.Count, 1) '取得最下方的儲存格
With myRng1
If Len(.PrefixCharacter & .Formula) > 0 Then
Set myRng2 = myRng1 '若最下方的儲存格符合條件時
Else
With .End(xlUp)
If Len(.PrefixCharacter & .Formula) > 0 Then
Set myRng2 = .Cells(1)
End If
End With
End If
End With
If myRng2 Is Nothing Then MsgBox "沒有輸入任何資料": Exit Sub
Set myRng = Range(myRng2.Address)
'===================================== 取代開始
For I = 3 To myRng.Row
OldName = filePach & Wok.Cells(I, 1)
NewName = filePach & Wok.Cells(I, 2)
If Wok.Cells(I, 1).Value <> "" And Wok.Cells(I, 2).Value <> "" Then
If myFso.FileExists(FileSpec:=OldName) Then
Name OldName As NewName ' 更改檔名，並將檔案搬移至另一個目錄中。
Wok.Cells(I, 3).Value = "Yes"
Else
Wok.Cells(I, 3).Value = "No"
End If
End If
Next
'=====================================
Set myRng1 = Nothing '物件的釋放
Set myRng2 = Nothing
Set myFso = Nothing
End Sub