EXCEL VBA ファイル名の変更・ファイルの一括変更・ファイルの指定変更　（ファイルの操作）

2020年8月12日

EXCEL VBA ファイル名の変更・ファイルの一括変更・ファイルの指定変更　（ファイルの操作・取得）

●はじめに

社内の業務で色々なファイルを取り扱う事があると思いますが、10ファイル程度でしたら、手動で取り扱う事が出来ると思いますが、100件・1000件以上となると、とても大変です。ここで説明するのは、ファイル名の一括変更方法です。VBAプログラムを利用する事で、連続でファイル名を変更する事が出来ます。それでは、サンプルプログラムを交えて説明いたします。

●書式の説明　ファイルオブジェクト.Name

●ファイルオブジェクト　Name

Name　旧ファイル名　As 新ファイル名

※ファイル名を変更します。

●FileSystemObjectの設定方法（参照設定）

●【FileSystemObject】とは、さまざまなファイルやフォルダー情報を調べたり、ファイルやフォルダーをVBAプログラムで操作する時に、FileSystemObjectを利用して簡単に情報取得や操作を行う事が出来ます。これから説明するプログラムにも利用していますので、必ず下記の通りに設定して下さい。

●FileSystemObjectを利用するための参照設定

【設定方法】
①VBE（Visual Basic Editor)から【ツール】を選択する
②【参照設定】をクリックする
③【参照設定ーVBAProject】の中から「Microsoft Scripting Runtime」にチェックする
④【OK】ボタンをクリックして設定します。

指定したファイル名を変更する　（ファイルパス設定）

●プログラム説明　【サンプル①】　Name

下記のサンプルプログラムは、指定したファイル名を変更するサンプルプログラムです。
旧ファイル名を新ファイル名に変更します。事前にA列の【旧ファイル名】とB列の【新ファイル名】を設定します。

プログラムを実行すると、指定した【旧ファイル名】を【新ファイル名】に変更されます。
【注意】新ファイル名は、同じファイル名を割り振るとエラーになります。なお、サンプル②では、このエラーを解消する方法も説明いたします。

【下記のプログラムを実行準備】
①　シート名を「Sheet1」
②　”C:\DATA”のフォルダーを作成します。
③　②で作成したDATAフォルダー内に、アンケート①～⑤.pdfを作成します。

'
'******** AKIRA55.COM ******* https://akira55.com/file_change_name '
'
Sub FilenameChange01() '指定したファイル名を変更します。

    Dim ws01 As Worksheet
    Dim lRow, I As Long
    Dim FolderName, OldFile, NewFile As String
    
    Set ws01 = Worksheets("Sheet1")
    
    FolderName = "C:\DATA" '保存されている保存先（フォルダー）
    
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row  'A列の最終行を取得
    
    For I = 6 To lRow  '最終行まで繰り返す
    
        OldFile = FolderName & "\" & ws01.Cells(I, "A")
        NewFile = FolderName & "\" & ws01.Cells(I, "B")
        
        MsgBox NewFile
        
        Name OldFile As NewFile 'ファイル名を変更します。
    
    Next I

End Sub
'

'******** AKIRA55.COM ******* https://akira55.com/file_change_name '

Sub FilenameChange01() '指定したファイル名を変更します。

Dim ws01 As Worksheet

Dim lRow, I As Long

Dim FolderName, OldFile, NewFile As String

Set ws01 = Worksheets("Sheet1")

FolderName = "C:\DATA" '保存されている保存先（フォルダー）

lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得

For I = 6 To lRow '最終行まで繰り返す

OldFile = FolderName & "\" & ws01.Cells(I, "A")

NewFile = FolderName & "\" & ws01.Cells(I, "B")

MsgBox NewFile

Name OldFile As NewFile 'ファイル名を変更します。

Next I

End Sub

●実行前～実行後　※プログラム実行後、A列で指定したファイル名をB列に指定したファイル名に変換されました。今回は、５ファイルに対してファイル名の変換を行いましたが、このプログラムを利用すれば、100でも1000でもファイル名を変換する事が出来ます。
（画面クリックして拡大）

指定したファイル名を変更する　（新しいファイル名を確認してエラー制御）

●プログラム説明　【サンプル②】　Name

下記のサンプルプログラムは、サンプル①プログラムの応用になります。旧ファイル名から新ファイル名へ変換しますが、今回のプログラムは、機能追加として下記の機能を追加しました。

【機能追加】
①新ファイルが変換出来るか事前にチェックする。
②旧ファイル名から新ファイル名へ変換した結果がC列に反映する。

【下記のプログラムを実行準備】
①　シート名を「Sheet2」
②　”C:\DATA”のフォルダーを作成します。
③　②で作成したDATAフォルダー内に、アンケート①～⑤.pdfを作成します。
注意：【FileSystemObject】の設定を必ず行って下さい。

'
'******** AKIRA55.COM ******* https://akira55.com/file_change_name '
'

Sub FilenameChange02() 'ファイルを確認してエラー制御


    Dim File_function As New Scripting.FileSystemObject
    
    Dim ws01 As Worksheet
    Dim lRow, I As Long
    Dim FolderName, OldFile, NewFile As String
    
    Set ws01 = Worksheets("Sheet2")
    
    FolderName = "C:\DATA" '保存されている保存先（フォルダー）
    
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row  'A列の最終行を取得
       
    For I = 6 To lRow  'A列の最終行まえ繰り返す
    
    
        OldFile = FolderName & "\" & ws01.Cells(I, "A")  'A列から旧ファイル名を取得
        NewFile = FolderName & "\" & ws01.Cells(I, "B")  'B列から新ファイル名を取得
    
        If File_function.FileExists(NewFile) = False Then
               'ファイル名の存在を確認します。既に新ファイル名があれば、変換不可
               
                Name OldFile As NewFile 'ファイル名を変更します。(旧ファイル⇒新ファイル)
                ws01.Cells(I, "C") = "完了"
            Else
                ws01.Cells(I, "C") = "変換不可"
                
        End If
    
    Next I

End Sub
'

'******** AKIRA55.COM ******* https://akira55.com/file_change_name '

Sub FilenameChange02() 'ファイルを確認してエラー制御

Dim File_function As New Scripting.FileSystemObject

Dim ws01 As Worksheet

Dim lRow, I As Long

Dim FolderName, OldFile, NewFile As String

Set ws01 = Worksheets("Sheet2")

FolderName = "C:\DATA" '保存されている保存先（フォルダー）

lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得

For I = 6 To lRow 'A列の最終行まえ繰り返す

OldFile = FolderName & "\" & ws01.Cells(I, "A") 'A列から旧ファイル名を取得

NewFile = FolderName & "\" & ws01.Cells(I, "B") 'B列から新ファイル名を取得

If File_function.FileExists(NewFile) = False Then

'ファイル名の存在を確認します。既に新ファイル名があれば、変換不可

Name OldFile As NewFile 'ファイル名を変更します。(旧ファイル⇒新ファイル)

ws01.Cells(I, "C") = "完了"

Else

ws01.Cells(I, "C") = "変換不可"

End If

Next I

End Sub

●実行前～実行後　※プログラム実行後、A列で指定したファイル名をB列に指定したファイル名に変換するのですが、今回は、変換後となるB列の「新ファイル」をチェックして変換できるか確認してファイル名を変換します。
（画面クリックして拡大）

指定したファイル名を変更する　（新しいファイル名を確認してエラー制御）

●プログラム説明　【サンプル③】　Name

下記のサンプルプログラムは、サンプル①＋②プログラムの応用になります。基本的に旧ファイル名から新ファイル名へ変換しますが、今回のプログラムは、機能追加として下記の機能を追加しました。

●プログラムの説明
（今回のプログラムは２つのプログラムで構成されています。）
「ファイル名取得」・・・・Sub FilenameChange03()
「ファイル名変換」・・・・Sub FilenameChange04()

【機能追加】
①新ファイルが変換出来るか事前にチェックする。
②旧ファイル名から新ファイル名へ変換した結果がC列に反映する。
③ファイル名を変換するファイルをダイアログボックスから選択する（複数選択）
④旧ファイル名から新ファイル名に変換する際に、事前に新ファイル名が登録されているかチェックします。【下記のプログラムを実行準備】
・　シート名を「Sheet3」
・　実行ボタンを作成
「ファイル名取得」・・・・Sub FilenameChange03()
「ファイル名変換」・・・・Sub FilenameChange04()
注意：【FileSystemObject】の設定を必ず行って下さい。

●「ファイル名取得」・・・・Sub FilenameChange03()

'
'******** AKIRA55.COM ******* https://akira55.com/file_change_name '
'
Sub FilenameChange03()  'ダイアログボックスを表示してファイル名一覧を作成します。


    Dim File_function As New Scripting.FileSystemObject
    
    Dim lRow, I, F As Long
    Dim FolderName, OldFile, NewFile As String
    Dim FileName As Variant
    Dim ws01 As Worksheet
    
    Set ws01 = Worksheets("Sheet3")
    
    FileName = Application.GetOpenFilename(MultiSelect:=True)
            'ダイアログボックスが表示（MultiSelect:=Trueでファイルを複数選択）
    
    
    If FileName(1) <> False Then
            
                FolderName = File_function.GetParentFolderName(FileName(1))
                '選択した最初のファイル名からフォルダーまでのルートを取得する
            
            Else
                MsgBox "作業をキャンセルされました"
                Exit Sub 'プログラムを終了
                
    End If
    
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row  'A列の最終行を取得
       
    ws01.Range("A6:A" & lRow + 1).ClearContents 'A列のデータ（文字列のみ）をクリアー
       
                   
    F = 1  '選択ファイルの１件目を設定
       
    For I = 6 To 5 + UBound(FileName) '選択したファイルの数を繰り返す。（最大値）
    
        ws01.Range("A" & I) = File_function.GetFileName(FileName(F))
        'ファイル名を順番にA列（セル）へ転記します。
        
        F = F + 1
        '次のファイル名を指定するために＋１加算する。
    Next I

    ws01.Range("A3") = FolderName  '選択したフォルダーバスをセル「A3]へ転記

End Sub
'

'******** AKIRA55.COM ******* https://akira55.com/file_change_name '

Sub FilenameChange03() 'ダイアログボックスを表示してファイル名一覧を作成します。

Dim File_function As New Scripting.FileSystemObject

Dim lRow, I, F As Long

Dim FolderName, OldFile, NewFile As String

Dim FileName As Variant

Dim ws01 As Worksheet

Set ws01 = Worksheets("Sheet3")

FileName = Application.GetOpenFilename(MultiSelect:=True)

'ダイアログボックスが表示（MultiSelect:=Trueでファイルを複数選択）

If FileName(1) <> False Then

FolderName = File_function.GetParentFolderName(FileName(1))

'選択した最初のファイル名からフォルダーまでのルートを取得する

Else

MsgBox "作業をキャンセルされました"

Exit Sub 'プログラムを終了

End If

lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得

ws01.Range("A6:A" & lRow + 1).ClearContents 'A列のデータ（文字列のみ）をクリアー

F = 1 '選択ファイルの１件目を設定

For I = 6 To 5 + UBound(FileName) '選択したファイルの数を繰り返す。（最大値）

ws01.Range("A" & I) = File_function.GetFileName(FileName(F))

'ファイル名を順番にA列（セル）へ転記します。

F = F + 1

'次のファイル名を指定するために＋１加算する。

Next I

ws01.Range("A3") = FolderName '選択したフォルダーバスをセル「A3]へ転記

End Sub

●「ファイル名変換」・・・・Sub FilenameChange04()

'
'******** AKIRA55.COM ******* https://akira55.com/file_change_name '
'

Sub FilenameChange04()  '指定した新ファイル名を変換します。


    Dim File_function As New Scripting.FileSystemObject
    Dim RC As Integer
    Dim lRow, I As Long
    Dim FolderName, OldFile, NewFile As String
    Dim ws01 As Worksheet
    
    Set ws01 = Worksheets("Sheet3")
    
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row  'A列の最終行を取得
    
    For I = 6 To lRow
        If IsEmpty(ws01.Range("B" & I)) = True Then
            MsgBox "新ファイル名を指定していないセルがあります。"
            Exit Sub
        End If
    Next I
    
    
    RC = MsgBox("選択したファイル名を変更しますか？", vbYesNo + vbQuestion, "確認")
              'ファイル名変換を実行するか確認します。
    If RC = vbNo Then
                MsgBox ("ファイル名変換をキャンセルしました。")
                Exit Sub   'プログラムを中断
    End If
    
    FolderName = ws01.Range("A3") '保存されている保存先（フォルダーパス）
       
    For I = 6 To lRow
    
        OldFile = FolderName & "\" & ws01.Cells(I, "A") 'A列から旧ファイル名を取得
        NewFile = FolderName & "\" & ws01.Cells(I, "B") 'B列から新ファイル名を取得
    
        If File_function.FileExists(NewFile) = False Then
               
                Name OldFile As NewFile 'ファイル名を変更します。(旧ファイル⇒新ファイル)
                ws01.Cells(I, "C") = "完了"
            Else
                ws01.Cells(I, "C") = "変換不可"
                
        End If
    
    Next I

End Sub
'

'******** AKIRA55.COM ******* https://akira55.com/file_change_name '

Sub FilenameChange04() '指定した新ファイル名を変換します。

Dim File_function As New Scripting.FileSystemObject

Dim RC As Integer

Dim lRow, I As Long

Dim FolderName, OldFile, NewFile As String

Dim ws01 As Worksheet

Set ws01 = Worksheets("Sheet3")

lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得

For I = 6 To lRow

If IsEmpty(ws01.Range("B" & I)) = True Then

MsgBox "新ファイル名を指定していないセルがあります。"

Exit Sub

End If

Next I

RC = MsgBox("選択したファイル名を変更しますか？", vbYesNo + vbQuestion, "確認")

'ファイル名変換を実行するか確認します。

If RC = vbNo Then

MsgBox ("ファイル名変換をキャンセルしました。")

Exit Sub 'プログラムを中断

End If

FolderName = ws01.Range("A3") '保存されている保存先（フォルダーパス）

For I = 6 To lRow

OldFile = FolderName & "\" & ws01.Cells(I, "A") 'A列から旧ファイル名を取得

NewFile = FolderName & "\" & ws01.Cells(I, "B") 'B列から新ファイル名を取得

If File_function.FileExists(NewFile) = False Then

Name OldFile As NewFile 'ファイル名を変更します。(旧ファイル⇒新ファイル)

ws01.Cells(I, "C") = "完了"

Else

ws01.Cells(I, "C") = "変換不可"

End If

Next I

End Sub

●実行前～実行後　※プログラム実行後、下記の通りに実行されます。
①ファイル名を選択するとダイアログボックスが表示されます。
②ファイルを選択して、旧ファイル名としてファイル名とフルパスを取得します。
③変換する新しいファイル名を入力します。
④「ファイル名変換」ボタンをクリックします。（実行）
⑤変換結果が表示されます。
※変換結果が「完了」ならば、新ファイル名へ変換されています。
（画面クリックして拡大）