全てのサブフォルダのファイル名を変更する。
全てのサブフォルダのファイル名を変更する
設計書のドキュメントファイルを自動生成する野良マクロと遭遇しました。怒りを覚えたが、お仕事なので解読しましたw。
その処理の中で、ドキュメント生成ができたら普通のファイル名、出来なければファイル名の頭に”×”が付きます。
10ファイルくらいならいいのですが、100ファイルを超えるとやってられないですよね。
なので、すべてのサブフォルダのエクセルファイル名を変更するコードを考えました。
1 自動生成されたファイルの例
以下の画像のようなファイル構成があります。
以下の画像のように、ファイルA、ファイルBの中に先頭に×が付いているファイルと、付いていないファイルがあります。
×が付いているファイルを、編集後に×を取ります。×がついたファイルが数百ファイルも有ったらやってられないですよね。
では、ピョログラミングでハムハムしましょう!
2 実際のコード
Sub サブフォルダのファイル名を更新する() Dim fso As Object: Set fso = CreateObject("scripting.filesystemobject") Dim myPath As String: myPath = ThisWorkbook.Path Dim targetPath As String Dim oldName As String Dim newName As String Dim myFolder As Variant For Each myFolder In fso.GetFolder(myPath).SubFolders targetPath = ThisWorkbook.Path & "\" & myFolder.Name Dim myFile As Variant For Each myFile In fso.GetFolder(targetPath).Files oldName = myFile.Name 'ファイル名の頭に×があれば、MIDで×を除いたファイル名にする。 If Mid(oldName, 1, 1) = "×" Then newName = Mid(oldName, 2) oldName = targetPath & "\" & oldName newName = targetPath & "\" & newName 'ファイル名の変更(Nameステートメント) Name oldName As newName End If Next Next End Sub
FSOと、Nameステートメントを使います!
3 処理結果
下の画面の通り、ファイル名から×が取れております。
ファイル名を変更する「Name」ステートメント、VBA9年目にして初めて知りました。まだまだ奥が深いですVBA。
ではでは、この辺で(^^)/~~~