在進入閱讀本文章的內容之前,
如果不了解本篇的內容,有興趣可以參閱之前撰寫的文章,
這是一篇教您如何透過VBA程式來批次更改檔名的教學。
接下來本篇文章,是關於在進行檔案名稱變更時,
程式執行中可能出現的問題,進行進行說明。
如果您在您的程式中也遇到相同的問題,不妨以以下簡單的方式,
測試看看。
目錄
{tocify} $title={目錄}
前言
話說在前些日子,凸眼角角頻道內,來了一則訊息,這是關於之前VBA批次改檔名教學程式,所提出的問題。裡面說到,如果檔名出現了特殊文字,例如日文中,有些漢字雖然看起來和繁體字差不多,但是實際放大看的話,其實是不一樣的。
舉例來說
繁體字
日文漢字
產 産
可能有些人會有這樣的經驗,在以前的windows版本,如果沒有辦法切換環境語言的情況下,若想要玩到非本機系統語言的電腦遊戲,可能會透過applocale來進行轉換,不然很有可能就會出現無法看懂的亂碼。
問題重現
這邊就以上面所述,產字的差異,製作兩個檔案進行測試。
FileNameChange 是撰寫VBA的Excel程式檔,
在程式中因為路徑指定在當前資料夾,因此會和要修改檔案的資料放在一起。
下面圖片就是透過程式列出來的檔案清單
這邊可以很明顯看到,產的這個文字,在清單裡面已經出現了問號 ?
,文字已經沒辦法辨識。
接著在要更改檔名的地方輸入要更改的檔名,
繁體字的檔名 這邊設定要更改檔名為測試1
日文字的檔名 這邊設定要更改檔名為測試2
執行後便出現在程式中所設定的錯誤。
關於錯誤碼:52
可以參閱微軟網站上的說明
不正確的檔案名稱或號碼 (錯誤 52)
https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/bad-file-name-or-number-error-52
但是仔細進到更改後的資料夾查看,可以看到繁體字的檔案名稱已經正常改為測試1。反觀日文字的檔名卻還是沒有更改。
我們可以利用VBA編輯器,使用快捷鍵F8 進行逐行除錯。
在程式的執行區中,可以看到,在取得名稱的時候,
與列出清單的名稱相同,這裡也把 生? (日) 的問號 ? 帶過來了。
這個問號 ? 就是導致這個問題發生的原因。
這會造成存取時檔案路徑的錯誤。
從下圖可以看出,路徑的部分出現
問號 ?
這會導致檔案路徑錯誤。
那麼為什麼在VBA在執行程式列出清單的時候,
文字會變成亂碼呢?
問題解決1
這個問題可能在於某些文字屬於Unicode的文字,
由於VBA支援Unicode程度有限, 遇到日文的環境依存文字,
會使得檔名在使用dir查詢後產生文字變成? 的問題
這會使路徑發生錯誤, 引發錯誤52:不正確的檔案名稱或數目
比較簡單的方式是盡量不要使用這些日文的環境依存文字
但如果真的需要大批更改類似不支援的文字檔名,
在教學影片程式不修改的情況下,
可以在windows 控制台-> 地區-> 系統管理 ->
非Unicode程式的語言-> 變更系統地區設定->勾選 Beta: 使用Unicode
UTF-8 提供全球語言支援
再重新開機, 重新執行程式後, 經測試出現的檔案名稱正常沒出現 ? ,
也可以修改檔名
只是這樣會有缺點, 最上方的標題欄, VBA的編輯介面有些會有亂碼的現象。
建議改完檔名後, 再重新取消勾選 Beta: 使用Unicode UTF-8
提供全球語言支援
即可恢復原來正常的畫面。
注意 :
依照以上的方式,經測試後有時還是會發生錯誤,而導致失敗,
以上做法並非完美的作法,後續測試如果有完整的解決方法會另外再更新文章。
遇到類似的問題可以用這種簡單的方式看看。
如果還是不行就只能盡量不用有問題的文字。
問題解決2
使用FSO物件處理
要使用FSO 物件之前,必須要先從VBE編輯器引用Microsoft Scripting Runtime。
引用的方式如下
首先在工具的地方點一下,下方會出現設定引用項目
接著在可引用項目內,找到Microsoft Scripting Runtime
並打勾,之後按下確定。
這樣才能開始使用FSO物件。
使用FSO物件的列出檔案清單程式碼
程式碼
Sub ListFile()
' 異常處理
On Error GoTo ErrorMsg
' 關閉畫面更新
Application.ScreenUpdating = False
' =====================================================
' 設定標題
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
'========================================================
'設定使用FSO物件
Dim myfso As New FileSystemObject
Dim myFile As File, i As Integer, subFiles As Files
Set myFiles = myfso.GetFolder(ActiveWorkbook.path).Files
' 設定儲存格計算用變數
' 因為要從A2開始存放資料,所以設定為2
i = 2
For Each myFile In myFiles
' 依序放入資料
' No.依序放入 編號至 A列, 編號從1開始 count-1
Range("A" & i).Value = i - 1
' 檔案名稱(含副檔名) 依序放入 B列
Range("B" & i).Value = myFile.Name
'使用Split函數 將B列文字的檔案名稱及副檔名拆開 各自放入 C列 和 D列
Range("C" & i).Value = Split(Range("B" & i).Value, ".")(0)
Range("D" & i).Value = Split(Range("B" & i).Value, ".")(1)
' i 變數 1
i = i + 1
Next
' =====================================================
' 取得最後一行的行數
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
這時可以看到,原本日文產字已經可以正常列出在清單內了,並未出現問號 ?
使用FSO物件的更改檔名程式碼
列出檔案清單後,接著在更改檔名的位置寫上名稱。
最後透過FSO物件更改的檔案名稱也都正常,沒有發生錯誤。
程式碼
Sub ChangeFileName()
'異常處理
On Error GoTo ErrorMsg
' 關閉畫面更新
Application.ScreenUpdating = False
' 設定FSO物件
Dim myfso As New FileSystemObject
Dim myFile As File, count As Integer, subFiles As Files
Set myFiles = myfso.GetFolder(ActiveWorkbook.path).Files
'遍歷所有檔案並更改檔名
i = 2
For Each myFile In myFiles
If Range("E" & i).Value <> "" And StrComp(Range("C" & i).Value, Range("E" & i).Value) <> 0 Then
myFile.Name = Range("E" & i).Value & "." & Range("D" & i).Value
End If
i = i + 1
Next
' 開啟畫面更新
Application.ScreenUpdating = True
' =====================================================
' 提示已經完成
MsgBox "Finish"
Exit Sub
ErrorMsg:
MsgBox "發生錯誤,請聯絡開發者! " & Chr(10) & "錯誤碼 : " & Err.Number & " 錯誤說明 : " & Err.Description
End Sub