VBA 製作批次變更檔名的小程式



相信有很多人在使用電腦時,隨著檔案越來越多,想要進行管理的時候。
發現平常沒有好好整理檔案,又或者想要將檔案批次進行更改時。
都需要花大量的時間進行更改。

甚至是工作上,需要整理大批檔案並修改檔名時。
更是會讓人修改到頭昏眼花。

以下的程式,提供給有需要學習及需要的人當作參考。
撰寫的程式稍微多一點,因此分為幾部影片慢慢說明。

如果真的沒有什麼時間,可以複製程式碼到Excel的程式碼編輯區,
直接使用即可。

關於使用部分可以參考說明及各影片最後的結尾,
會有使用的說明影片,可以供使用上的參考。

這個修改檔名的程式是使用Excel的VBA撰寫而成,
除了可以直接在Excel上修改檔名後,透過VBA進行檔案名稱修改之外。
如果要修改副檔名也可以一併修正。

由於可以列出檔案清單,所以要修改的部分也一目了然。
另外如果你只是想要目前在檔案夾裡面的檔案清單,
透過這個程式就可以列出所有檔案名稱,也算是很方便的工具。

修改檔名不限於檔案格式,Excel 清單列出來的部分,
應該大部分皆可以修正其檔案名稱。

以下的程式可以自己修改或擴充。
未能夠符合自己的內容,可以依照自己的需求修正即可。

影片分為6個階段,
階段1會先進行程式的說明,
階段2~階段5為本次程式撰寫的主要內容。
階段6為程式的優化部分以及可能會出現的bug說明。

透過6個影片的教學,相信應該會收穫不少。
現在就讓我們開始吧。Let's Go!!

目錄

{tocify} $title={目錄} 


開始製作程式: 階段1 程式說明


Point!

1. 批次變更檔名的小程式預覽

2. F2快捷鍵更改檔名

3. CMD更改檔名(小範例)


程式最後完成的結果會如同以下的圖片,
Excel 的   
A欄為 檔案的數量,數字1表示為第1個...以此類推
B欄為  檔案名稱,這個檔案包含副檔名,這是透過VBA檢索出來的
C欄為  純檔案名稱,也就是不包含副檔名的名稱
D欄為  檔案的副檔名,如果想要修改副檔名,可以列出清單後再修正
E欄為  想要修改的檔案名稱,基本上如果沒有要修正副檔名,只要修改這裡就可以了

由於Excel 的儲存格並沒有鎖定,因此在修改檔名時,
不要去修正到ABC欄位,不然可能會發生錯誤。
D欄位只在要修正副檔名的時候再修改即可。



這個是程式要說明時,所準備的測試檔案,
不一定要跟著一起準備這些檔案。
由下圖可以看到,不一樣檔案的資料。



階段1會先進行程式的說明
首先我們會先進行程式的預覽,以及可以看到最後程式所展現的效果

接著說明,如果只是單純要修改幾個檔案名稱,
可以使用快捷鍵F2,來進行修改。
不一定要使用滑鼠右鍵,再展開選單更改檔案名稱。

最後說明使用微軟系統內建的CMD,
也可以進行一些簡單的檔名更改。

其實不管是CMD或者是powershell 也是可以進行簡易的修改。
這部分由於不在Excel VBA範圍內,暫時不仔細說明。


關於階段1  程式說明可參考以下連結影片





開始製作程式: 階段2


Point!

1. 檔案及資料夾位置

2. 宣告需要的變數

3. 設定標題


階段2主要為本程式撰寫時,檔案及資料夾所在的位置,
關於位置,也就是所謂的檔案路徑。
路徑如果有問題,是找不到檔案的,而且也會發生錯誤。

關於檔案操作,很多在撰寫的例子中,路經一旦錯誤,
通常都會發生找不到檔案的錯誤。
如果想要了解路徑的狀況,
可以透過MsgBox來了解,Msgbox對於除錯也是很好用的函數。

關於MsgBox函數,
可參閱 部落格文章  顯示訊息窗



接著會宣告列出清單程式所需要的變數,
及設定標題的格式。

這個部分會先進行標題格式的初期設定。


關於階段2可參考以下連結影片





開始製作程式: 階段3


Point!

列出檔案清單


階段3 要撰寫的是列出檔案清單的主要程式部分,
透過 Do While ...  Loop 的迴圈處理,列出檔案的清單。

在這邊因為不知道檔案有多少個,
所以使用For迴圈進行處理的話,就比較不合適。
 

關於階段3可參考以下連結影片





開始製作程式: 階段4


Point!

1. 儲存格版面調整

2. 異常處理

3. ScreenUpdating設定


階段4 屬於最後的修飾處理
儲存格的調整,異常處理,甚至於ScreenUpdating設定,
皆有進行說明。

ScreenUpdating 為螢幕更新的意思。
如果沒有進行螢幕更新關閉的設定時,
Excel在程式執行時,會不斷地進行螢幕更新,
當迴圈跑的次數非常多時,有可能會造成一些狀況。
也許可能螢幕當掉不會動之類的。
當然如果次數少的時候可能會沒有什麼感覺。

到這裡  就可以算是把列出檔案清單的程式完成了。


關於階段4可參考以下連結影片



程式碼

Sub ListFile()

  ' 異常處理
  On Error GoTo ErrorMsg
    
  ' 關閉畫面更新
  Application.ScreenUpdating = False
    
  ' 宣告變數
  ' bufFolder為檔案清單宣告為字串  count為儲存格計算用宣告為整數
  Dim bufFolder As String, count As Integer
    
  ' lastRow為取得檔案的最後一行,宣告為整數
  Dim lastRow As Integer
    
  '使用Dir函數建立目錄中的檔案清單
  bufFolder = Dir(ActiveWorkbook.Path & "\" & "*.*")
    
  ' =====================================================
    
  ' 設定標題
  Range("A1").Value = "No."
  Range("B1").Value = "檔案名稱(含副檔名)"
  Range("C1").Value = "檔案名稱"
  Range("D1").Value = "副檔名"
  Range("E1").Value = "更改檔名"
    
  '設定標題顏色
  With Range("A1:E1")
     .Interior.Color = RGB(128, 116, 187)  ' 設定儲存格顏色
     .Font.Color = RGB(255, 255, 255)       ' 設定字型顏色
  End With
    
  ' =====================================================
    
  ' 設定儲存格計算用變數
  ' 因為要從A2開始存放資料,所以設定為2
  count = 2
    
  ' Do...while...Loop迴圈 執行到檔案為空
  Do While bufFolder <> ""
    
     ' 依序放入資料
     ' No.依序放入 編號至 A列, 編號從1開始 count-1
     Range("A" & count).Value = count - 1
        
     ' 檔案名稱(含副檔名) 依序放入 B列
     Range("B" & count) = bufFolder
        
     ' 使用Split函數 將B列文字的檔案名稱及副檔名拆開 各自放入 C列 和 D列
     Range("C" & count) = Split(Range("B" & count), ".")(0)
     Range("D" & count) = Split(Range("B" & count), ".")(1)
        
     ' count變數+ 1
     count = count + 1
        
        
     ' 繼續尋找下個檔案
     bufFolder = Dir()
        
  Loop
    
  ' =====================================================
    
  ' 取得最後一行的行數
  lastRow = Range("A1").End(xlDown).Row
    
  ' 設定格式
  With Range("A1:E" & lastRow)
       .Borders.LineStyle = xlContinuous
       .Borders.Weight = xlMedium
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .Font.FontStyle = "微軟正黑體"
       .RowHeight = 25
       .CurrentRegion.Columns.AutoFit
  End With
     
  With Range("E1: E" & lastRow)
       .ColumnWidth = 16
  End With
     
  ' 隔行上顏色
  Dim colorStep As Integer  ' 宣告colorStep變數為整數
     
    ' 因為隔行上顏色從第3行開始 colorStep 起始值為3
    For colorStep = 3 To lastRow Step 2
        Range("A" & colorStep & ":E" & colorStep).Interior.Color = RGB(241, 191, 242)
    Next
      
    ' 開啟畫面更新
    Application.ScreenUpdating = True
      
    ' =====================================================
      
    '提示完成
    MsgBox "Finish"
      
    Exit Sub
         
ErrorMsg:
    MsgBox "發生錯誤,請聯絡開發者! " & Chr(10) & "錯誤碼 : " & Err.Number & "  錯誤說明 : " & Err.Description         
End Sub




開始製作程式: 階段5


Point!

1. 更改檔名

2. 清除所有資料

3. 製作程式執行按鈕

4. 最終測試


階段5 主要為最終測試的說明 
以及更改檔名和清除所有資料程式的撰寫

更改檔名會有一些比較特殊的情況要注意,
優化的部分會放在階段6說明。

最後為了要方便使用我們所撰寫的程式,
總是要給個按鈕,總不可能每次都跑到Excel的程式編輯區執行吧@@~

按鈕也可以是圖案,只要指定好巨集,
便可以讓程式的巨集執行。


關於階段5可參考以下連結影片




程式碼

Sub ChangeFileName()

  ' 異常處理
  On Error GoTo ErrorMsg
    
  ' 關閉畫面更新
  Application.ScreenUpdating = False

  ' 宣告變數
    Dim i As Integer
    Dim lastRow As Integer
    Dim route As String
        
  ' 取得最後的行數
    lastRow = Range("A1").End(xlDown).Row
        
  ' =====================================================
        
  ' For迴圈確認更改檔名到最後一行
    For i = 2 To lastRow
       If Range("E" & i).Value <> "" And StrComp(Range("C" & i).Value, Range("E" & i).Value) <> 0 Then
          Name Range("B" & i).Value As Range("E" & i).Value & "." & Range("D" & i).Value
       End If
    Next
     
  ' =====================================================
     
  ' 提示已經完成
  MsgBox "Finish"
     
  Exit Sub
         
ErrorMsg:
  MsgBox "發生錯誤,請聯絡開發者! " & Chr(10) & "錯誤碼 : " & Err.Number & "  錯誤說明 : " & Err.Description

End Sub


' =====================清除所有資料================================

Sub ClearAll()

   Dim lastRow As Integer
   lastRow = Range("A1").End(xlDown).Row
   Range("A1:E" & lastRow).Clear

End Sub
 

開始製作程式: 階段6


Point!

1. 優化程式

2. 測試修改後程式效果

3. 程式修改前有可能的異常說明

    3.1 正常情況

    3.2 程式執行中,在同一磁碟中目錄路徑切換了

    3.3 程式執行中,切換成不同磁碟路徑


階段6算是程式部分的優化,
主要針對修改檔名的程式進行調整。

同時在影片的最後,也說明執行可能出現的一些狀況。
主要為一些意外狀況可能對路徑產生的問題,進行說明。

有興趣的話不妨可以看到最後。


關於階段6可參考以下連結影片




程式碼

Sub ChangeFileName()

  '異常處理
  On Error GoTo ErrorMsg
    
  ' 關閉畫面更新
  Application.ScreenUpdating = False
    
  ' 宣告變數
  Dim i As Integer
  Dim lastRow As Integer
    
  ' 取得最後的行數
  lastRow = Range("A1").End(xlDown).Row
    
  ' 宣告path變數, 為字串型態
  Dim path As String

  ' 把當前工作表的路徑指定給變數
  path = ActiveWorkbook.path & "\"
 
 '===============================
    
  ' For迴圈確認更改檔名到最後一行
  For i = 2 To lastRow
     If Range("E" & i).Value <> "" And StrComp(Range("C" & i).Value, Range("E" & i).Value) <> 0 Then
        
        Name path & Range("B" & i).Value As path & Range("E" & i).Value & "." & Range("D" & i).Value
            
     End If
  Next
    
  ' 開啟畫面更新
  Application.ScreenUpdating = True
    
  ' =====================================================
    
  ' 提示已經完成
  MsgBox "Finish"
    
  Exit Sub
    
ErrorMsg:
    
  MsgBox "發生錯誤,請聯絡開發者! " & Chr(10) & "錯誤碼 : " & Err.Number & "  錯誤說明 : " & Err.Description
        
End Sub 
張貼留言 (0)
較新的 較舊