用途,將左列目標檔名,更名為右列檔名
我是拿來做型號替換拉
原本都用批次檔寫的,想說麻煩直接用VBA寫好了
參考了之前買的書寫出來的,是本好書唷 ISBN -978-986-201-026-6
路徑要自己填喔!
檔案下載
書裡面說要開啟 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