はじめに

T4exf63です。
事前にファイルやフォルダの名称を話し合って統一したのに後になってから、
『この名前だと探し辛いし他チームとの名称統一したいからファイル（フォルダ）名ちょっと修正しといて！』
こういうことを言われたくないためにわざわざ事前に聞いても、後から言われることが度々あります。
そういうのに限って、大量の証跡やログがあって時間が無意味に奪われるんですよね。。あと早く終わっても褒められないし評価されない。

私が新入社員の時は、新人に振る仕事がないのと先輩が忙しかったこともありこういう、極論やらなくてもいいけど他の人に迷惑をかけず仕事した風に見える仕事をよく先輩から貰っていました。
けど、文句を言ってもしょうがありません。サラリーマンなんで！

これからの新卒には同じ思いをして貰いたくないので、これでも使って楽してください。そして空いた時間は資格勉強でもしましょう。

本題

今回はVBAのファイル（フォルダ）名称変更ツールです。
こちらもコピペですぐに使えます。

・開発環境

Microsoft Windows 11 Home
Microsoft Visual Basic for Application 7.1

・エクセルシート

基本的にシート内容は前回同様で、エクセルのフォーマットは以下です。

セルA：項番
セルB：ディレクトリ名（文末に￥があってもなくても可）
セルC：変更前ファイル（フォルダ）名
セルD：変更後ファイル（フォルダ）名
セルE：作成結果（〇・×）
セルF：備考（作成失敗時、原因出力）

・コード

Sub RenameFile()
    '===========================
    '【変数宣言】
    '===========================
    Dim BfullPath As String
    Dim AfullPath As String
    Dim Bkakutyousi As String
    Dim Akakutyousi As String
    Dim confirmMsg As String
    Dim flg As Integer
    Dim fso As Object
    Dim isFolder As Boolean
    Dim isFile As Boolean
    Dim i As Integer
        
    '===========================
    '【前処理】
    '===========================
    ' 確認メッセージ
    confirmMsg = "拡張子が変わりますが、処理を実行しますか？"
    ' FileSystemObjectを作成
    Set fso = CreateObject("Scripting.FileSystemObject")        
    '初期化
    i = 0
    
    '===========================
    '【メイン処理】
    '===========================
    '作成対象がなくなるまでループ
    Do Until Cells(3 + i, 2).Value = ""
        
        '================================
        'パスが\終わりか判定
        '================================
        If Right(Cells(3 + i, 2).Value, 1) = "\" Then
            BfullPath = Cells(3 + i, 2).Value & Cells(3 + i, 3).Value
            AfullPath = Cells(3 + i, 2).Value & Cells(3 + i, 4).Value
        Else
            BfullPath = Cells(3 + i, 2).Value & "\" & Cells(3 + i, 3).Value
            AfullPath = Cells(3 + i, 2).Value & "\" & Cells(3 + i, 4).Value
        End If
                
        '================================
        '拡張子の有無を判定
        '================================
        '初期化
        Bkakutyousi = ""
        Akakutyousi = ""
        
        '変更前のファイルの拡張子の有無を判定
        If InStrRev(Cells(3 + i, 3).Value, ".") > 0 Then
            ' 拡張子がある場合、拡張子を取得
            Bkakutyousi = Right(Cells(3 + i, 3).Value, Len(Cells(3 + i, 3).Value) - InStrRev(Cells(3 + i, 3).Value, "."))
        End If
        '変更後のファイルの拡張子の有無を判定
        If InStrRev(Cells(3 + i, 3).Value, ".") > 0 Then
            ' 拡張子がある場合、拡張子を取得
            Akakutyousi = Right(Cells(3 + i, 4).Value, Len(Cells(3 + i, 4).Value) - InStrRev(Cells(3 + i, 4).Value, "."))
        End If
        
        '================================
        '変更する対象が、ファイル、フォルダ、それ以外の判定
        '================================
        ' フォルダかどうかを判定
        isFolder = fso.FolderExists(BfullPath)
        ' ファイルかどうかを判定
        isFile = fso.FileExists(BfullPath)
    
        ' 結果を判定
        If isFolder Then
            'フォルダの場合
            flg = 1
        ElseIf isFile Then
            'ファイルの場合            
            '変更後ファイルの存在を確認
            If Len(Dir(AfullPath)) > 0 Then
                'エラー出力
                Cells(3 + i, 5).Value = "×"
                Cells(3 + i, 6).Value = "変更後ファイル名がすでに存在します。"
            Else
                flg = 2
            End If
        Else
            'それ以外の場合
            flg = 9
            'エラー出力
            Cells(3 + i, 5).Value = "×"
            Cells(3 + i, 6).Value = "変更前ファイル名が存在しないので作成できません"
        End If
        
        '================================
        '作成対象ごとに分岐
        '================================
        Select Case flg
            Case 1
                '================================
                'フォルダの場合
                '================================
                Name BfullPath As AfullPath
            Case 2
                '================================
                ' ファイルの場合
                '================================     
                'ファイルの拡張子が変更されるか判定
                If Bkakutyousi = Akakutyousi Then
                    '================================
                    '拡張子の変更がないのでそのままファイル名変更
                    '================================
                    Name BfullPath As AfullPath
                    '備考出力
                    Cells(3 + i, 5).Value = "〇"
                    Cells(3 + i, 6).Value = "-"
                Else
                    '================================
                    '拡張子が変わるので、処理を続行するか確認
                    '================================
                    ' ダイアログを表示
                    Dim confirmResult As VbMsgBoxResult
                    confirmResult = MsgBox(confirmMsg, vbQuestion + vbYesNo, "確認")
        
                    ' ユーザーの選択結果によって処理を実行
                    If confirmResult = vbYes Then
                        ' 処理を実行する場合
                        Name BfullPath As AfullPath
                        '備考出力
                        Cells(3 + i, 5).Value = "〇"
                        Cells(3 + i, 6).Value = "-"
                    Else
                        ' 処理を実行しない場合
                        '備考出力
                        Cells(3 + i, 5).Value = "×"
                        Cells(3 + i, 6).Value = "拡張子が変わるため処理しませんでした。"
                    End If
                End If    
            Case Else
                ' それ以外の場合
        End Select
        i = i + 1
    Loop
    ' FileSystemObjectを解放
    Set fso = Nothing
    MsgBox "ファイル名の変更が完了しました。"
End Sub

・コード説明

備忘録レベルです。

・ファイル、フォルダ判定
fso.FolderExists()
fso.FileExists()
ではture,falseが返ってくるので、それでファイルかフォルダかを判断している
また、毎回ループする度に値が上書きされるので、わざわざisFolder、isFileに初期化処理を入れてない。

    'フォルダかどうかを判定
    isFolder = fso.FolderExists(BfullPath)
    ' ファイルかどうかを判定
    isFile = fso.FileExists(BfullPath)
    
    ' 結果を判定
    If isFolder Then
        'フォルダの場合
    ElseIf isFile Then
        'ファイルの場合            
    Else
        'それ以外の場合
    End If

・処理中に確認画面を出す
Dim confirmMsg As String
は確認画面で出力する文字。変数に入れないでMsgBoxに直書きでも問題ない

Dim confirmResult As VbMsgBoxResult
は確認画面で入力した値を格納する変数。
今回は【vbYesNo】を指定しているのでvbYes、vbNoどちらかが値として入ってくるので、それで処理続行するかを分けてる。

    Dim confirmMsg As String
    ' 確認メッセージ
    confirmMsg = "拡張子が変わりますが、処理を実行しますか？"
    ' ダイアログを表示
    Dim confirmResult As VbMsgBoxResult
    confirmResult = MsgBox(confirmMsg, vbQuestion + vbYesNo, "確認")    
    ' ユーザーの選択結果によって処理を実行
    If confirmResult = vbYes Then
        ' 処理を実行する場合
    Else
        ' 処理を実行しない場合
    End If

・名前変更
今回のコードが長々と書いているがメインはこの1文。
他は、ごちゃごちゃしているがエラーとか出すためにお膳立てをしているだけ

Name 変更前のフルパス As 変更後のフルパス

これは、ファイル、フォルダどちらでもこの一文で変更できる。

Name BfullPath As AfullPath

おわりに

最初はNAMEとループだけですぐ作れんだろと思っていましたが、あまりに雑すぎて拡張子が変わったせいでファイルが即死みたいなことになってたので想定より少し時間がかかりました。
癖で必要に応じてその場その場で処理を追加してしまっているので、無駄が多いかもしれないので見返してあまりに酷かったら直すかもしれないです。
※拡張子も変わったせいでファイルがぶっ壊れても責任は負えません。

記：2023年6月8日　