全てのサブフォルダのファイル名を変更する。

全てのサブフォルダのファイル名を変更する

設計書のドキュメントファイルを自動生成する野良マクロと遭遇しました。怒りを覚えたが、お仕事なので解読しましたw。
その処理の中で、ドキュメント生成ができたら普通のファイル名、出来なければファイル名の頭に”×”が付きます。
10ファイルくらいならいいのですが、100ファイルを超えるとやってられないですよね。
なので、すべてのサブフォルダのエクセルファイル名を変更するコードを考えました。

1 自動生成されたファイルの例

以下の画像のようなファイル構成があります。
f:id:bimori466:20210320233921p:plain


以下の画像のように、ファイルA、ファイルBの中に先頭に×が付いているファイルと、付いていないファイルがあります。
f:id:bimori466:20210320232346p:plain


×が付いているファイルを、編集後に×を取ります。×がついたファイルが数百ファイルも有ったらやってられないですよね。
では、ピョログラミングでハムハムしましょう!

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 処理結果

下の画面の通り、ファイル名から×が取れております。
f:id:bimori466:20210320233435p:plain


ファイル名を変更する「Name」ステートメント、VBA9年目にして初めて知りました。まだまだ奥が深いですVBA。


ではでは、この辺で(^^)/~~~