批次改檔案名稱程式含特殊文字檔名的處理方式



在進入閱讀本文章的內容之前,
如果不了解本篇的內容,有興趣可以參閱之前撰寫的文章,


這是一篇教您如何透過VBA程式來批次更改檔名的教學。


接下來本篇文章,是關於在進行檔案名稱變更時,
程式執行中可能出現的問題,進行進行說明。

如果您在您的程式中也遇到相同的問題,不妨以以下簡單的方式,
測試看看。


目錄

{tocify} $title={目錄} 


前言

話說在前些日子,凸眼角角頻道內,來了一則訊息,這是關於之前VBA批次改檔名教學程式,
所提出的問題。裡面說到,如果檔名出現了特殊文字,例如日文中,有些漢字雖然看起來和繁體字差不多,但是實際放大看的話,其實是不一樣的。


舉例來說
  
繁體字                   日文漢字
  產                産


從上方中的 產 字, 雖然乍看之下,好像差不多,但事實上,兩個字是存在字碼差異的。然而就是因為如此,在不是unicode的環境下,日文字會變成亂碼,無法辨識。

可能有些人會有這樣的經驗,在以前的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

如果您有遇到使用Dir函數,列出來的檔案為 ? 或亂碼時, 也許可以使用FSO物件試看看喔。

張貼留言 (0)
較新的 較舊