【エクセルVBA】ファイル名を一括取得するVBAと一括置換するVBA

ふー、めんどうだなー。

どうされたんですか？

何十個もあるファイル名を変更しないといけないんです。何かいい方法ありませんかね？？

VBAで解決できますよ、ご紹介しましょう！

複数のファイル名を一括取得するVBAと、
複数のファイル名を一括置換するVBAをご紹介します。

対象ファイル種別はエクセル・CSV・ワードなど何でも可能です。

マクロ機能が有効なExcelブック「.xlsm」を作成

Excelブック「.xlsm」の作成方法が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】マクロ機能が有効なExcelブック「.xlsm」の作り方

コードを標準モジュールに貼り付け

標準モジュールの開き方が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】標準モジュールの開き方

標準モジュールを開いて、下記のコードを貼り付けて下さい。

コード

Sub main()
    
    
    ' 変数定義
    Dim objFileDialog As Object             'FileDialog
    Dim strTitle As String                  'タイトル
    Dim strPath As String                   'フォルダパス
    Dim strInitialPath As String            '初期フォルダパス
    Dim sh As Worksheet, flag As Boolean
    Dim rc As Integer

    For Each sh In Worksheets
        If sh.Name = "Sheet1" Then flag = True
    Next sh
    
    If flag = True Then
    
    'シートを選択
    Worksheets("Sheet1").Activate
    MsgBox "ファイル名を取得したい、フォルダを選択して下さい。" & Chr(13) & Chr(13) & "※シート「Sheet1」を上書きします。" & Chr(13) & "※上書きしたくない場合は、キャンセルをクリックして下さい。" & Chr(13) & "※実行後、この処理は戻せません。"
     

    ' フォルダ選択ダイアログの初期設定
    'ダイアログタイトル
    strTitle = "ファイル名を取得したいフォルダを選択して下さい"
    'ダイアログの初期パスをモジュール起動エクセルに設定
    strInitialPath = ActiveWorkbook.Path
     
    ' フォルダ選択ダイアログ表示
    Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
         
    With objFileDialog
        'タイトル
        .Title = strTitle

        '初期フォルダパス
        .InitialFileName = strInitialPath
         
        If .Show = False Then

            'キャンセル時
'            GoTo Exit_Function
            MsgBox "キャンセルされました。処理を終了します。"
            Worksheets("Sheet1").Activate
            Range("A1").Select
            End
        Else
        
            'フォルダパス取得
            strPath = .SelectedItems(1)
        End If
     
    End With
    
    
    '画面更新停止
    Application.ScreenUpdating = False

    '確認ダイアログ停止
    Application.DisplayAlerts = False

    ' 変数定義
    Dim lastRow As Long        '変数lastRowを整数とする

    '変数lastRowにA1セルから見た最下の行数を代入
    lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    
    'セルA2からC列最終行までのセルをクリア
    ThisWorkbook.Worksheets("Sheet1").Range(Cells(2, "A"), Cells(lastRow, "F")).ClearContents

 
    Dim FSO As FileSystemObject       '変数fsoをファイルやフォルダなどの専用入れ物とする
    
    '変数fsoをインスタンス化
    Set FSO = New FileSystemObject
    
    Dim fl As Folder        '変数flをフォルダとする
    
    'フォルダを指定
    Set fl = FSO.GetFolder(strPath)
    
        Worksheets("Sheet1").Range("A1").Value = "ファイル名（現在）" & vbCrLf & "編集不要"
        Worksheets("Sheet1").Range("B1").Value = "拡張子（現在）" & vbCrLf & "編集不要"
        Worksheets("Sheet1").Range("C1").Value = "ファイル名+拡張子（現在）" & vbCrLf & "編集不要"
        Worksheets("Sheet1").Range("D1").Value = "ファイル名（変更後）" & vbCrLf & "入力欄"
        Worksheets("Sheet1").Range("E1").Value = "拡張子（変更後）" & vbCrLf & "編集不要"
        Worksheets("Sheet1").Range("F1").Value = "ファイル名+拡張子（変更後）" & vbCrLf & "編集不要"
        
    Dim bname As Object
    Set bname = CreateObject("Scripting.FileSystemObject")
    
    Dim f As File        '変数fをファイルとする
    Dim i As Long: i = 2        '変数iを整数とする、 変数iを2整数とする
    
    '書式設定
    Columns("F:F").Select
    Selection.NumberFormatLocal = "G/標準"
    
    'シートを選択
    ActiveSheet.Name = "Sheet1"
    
    '書式設定
    Columns("A:F").Select
    Selection.ColumnWidth = 19.7
    Columns("A:F").EntireColumn.AutoFit
    Selection.NumberFormatLocal = "@"
    Columns(1).Interior.ColorIndex = 15
    Columns(2).Interior.ColorIndex = 15
    Columns(3).Interior.ColorIndex = 15
    Columns(5).Interior.ColorIndex = 15
    Columns(6).Interior.ColorIndex = 15
    Worksheets("Sheet1").Range("A1:C1").Interior.ColorIndex = 17
    Worksheets("Sheet1").Range("D1").Interior.ColorIndex = 46
    Worksheets("Sheet1").Range("E1:F1").Interior.ColorIndex = 6
    
    'フォルダ内のファイルを取得
    For Each f In fl.Files
        
        'セルCi（変数）の値に取得したフォルダ名を代入
'        Cells(i, 1).Value = f.Name
        
        Cells(i, 1).Value = bname.GetBaseName(f.Path)
        Cells(i, 2).Value = bname.GetExtensionName(f.Path)
        Cells(i, 3).Value = "=A" & i & "&" & """.""" & "&" & "B" & i
        Cells(i, 5).Value = bname.GetExtensionName(f.Path)
        Cells(i, 6).Value = "=D" & i & "&" & """.""" & "&" & "E" & i
        
        '変数iに1を加える
        i = i + 1
        
    Next
    
            ActiveSheet.Name = "Sheet1"
            
            '書式設定
            Columns("C:C").Select
            Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
            
            '書式設定
            Columns("F:F").Select
            Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
            
            '書式設定
            Selection.NumberFormatLocal = "G/標準"
            
            
            Worksheets("Sheet1").Range("F1").Value = "ファイル名+拡張子（変更後）" & vbCrLf & "編集不要"
            
            Cells(1, 1).Select

    Set objFileDialog = Nothing
    Set FSO = Nothing
    Set fl = Nothing
    Set bname = Nothing
    
    '画面表示ON
    Application.ScreenUpdating = False
    
    MsgBox "完了しました。処理を終了します。" & Chr(13) & "「Sheet1」シートを確認して下さい。"

    Else
            
        MsgBox "「Sheet1」シートがありません。先に「Sheet1」シートを追加して下さい。" & Chr(13) & "処理を終了します。"
    
    End If
        
    '画面更新　停止解除
        Application.ScreenUpdating = True

End Sub
Sub main2()
    
    
    ' 変数定義
    Dim objFileDialog As Object             'FileDialog
    Dim strTitle As String                  'タイトル
    Dim strPath As String                   'フォルダパス
    Dim strInitialPath As String            '初期フォルダパス
    Dim sh As Worksheet, flag As Boolean
    Dim rc As Integer

    For Each sh In Worksheets
        If sh.Name = "Sheet1" Then flag = True
    Next sh
    
    If flag = True Then
    
    'シートを選択
    Worksheets("Sheet1").Activate
    MsgBox "ファイル名を置換したい、フォルダを選択して下さい。" & Chr(13) & Chr(13) & "※ファイル名を上書きします。" & Chr(13) & "※上書きしたくない場合は、キャンセルをクリックして下さい。" & Chr(13) & "※実行後、この処理は戻せません。"
     
    ' フォルダ選択ダイアログの初期設定
    'ダイアログタイトル
    strTitle = "ファイル名を置換したいフォルダを選択して下さい"

    'ダイアログの初期パスをモジュール起動エクセルに設定
    strInitialPath = ActiveWorkbook.Path
     
    ' フォルダ選択ダイアログ表示
    Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
         
    With objFileDialog
        'タイトル
        .Title = strTitle

        '初期フォルダパス
        .InitialFileName = strInitialPath
         
        If .Show = False Then

            'キャンセル時
'            GoTo Exit_Function
            MsgBox "キャンセルされました。処理を終了します。"
            Worksheets("Sheet1").Activate
            Range("A1").Select
            End
        Else
        
            'フォルダパス取得
            strPath = .SelectedItems(1)
        End If
     
    End With
    
    
    '画面更新停止
    Application.ScreenUpdating = False

    '確認ダイアログ停止
    Application.DisplayAlerts = False

    '変数定義
    '変数lastRowを整数とする
    Dim lastRow As Long

    '変数lastRowにA1セルから見た最下の行数を代入
    lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

    '変数fsoをファイルやフォルダなどの専用入れ物とする
    Dim FSO As FileSystemObject
    
    '変数fsoをインスタンス化
    Set FSO = New FileSystemObject
    
    '変数flをフォルダとする
    Dim fl As Folder
    
    'フォルダを指定
    Set fl = FSO.GetFolder(strPath)

    '変数指定fileNameを文字列とする
    Dim fileName As String
        
'    Dim bname As Object
'    Set bname = CreateObject("Scripting.FileSystemObject")
    
    Dim f As File        '変数fをファイルとする
    Dim i As Long: i = 2        '変数iを整数とする、 変数iを整数2とする
        
    'フォルダ内のファイルを置換
    On Error Resume Next
    For Each f In fl.Files

        fileName = f.Name             ' ファイル名の取得
        If fileName = Cells(i, 3).Value Then ' ファイル名を変更したいファイル
        f.Name = Cells(i, 6).Value   ' ファイル名の変更

        '変数iに1を加える
        i = i + 1
        End If
    Next
        
    Cells(1, 1).Select

    Set objFileDialog = Nothing
    Set FSO = Nothing
    Set fl = Nothing
'    Set bname = Nothing
    
    '画面表示ON
    Application.ScreenUpdating = False
    
    MsgBox "完了しました。処理を終了します。" & Chr(13) & "「Sheet1」シートを確認して下さい。" & Chr(13) & Chr(13) & "※ファイル名重複などエラーは無視して、ファイル名置換処理は実行されません。"

    Else
            
        MsgBox "「Sheet1」シートがありません。先に「Sheet1」シートを追加して下さい。" & Chr(13) & "処理を終了します。"
    
    End If
        
    '画面更新　停止解除
        Application.ScreenUpdating = True

End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

Sub main()

' 変数定義

Dim objFileDialog As Object 'FileDialog

Dim strTitle As String 'タイトル

Dim strPath As String 'フォルダパス

Dim strInitialPath As String '初期フォルダパス

Dim sh As Worksheet, flag As Boolean

Dim rc As Integer

For Each sh In Worksheets

If sh.Name = "Sheet1" Then flag = True

Next sh

If flag = True Then

'シートを選択

Worksheets("Sheet1").Activate

MsgBox "ファイル名を取得したい、フォルダを選択して下さい。" & Chr(13) & Chr(13) & "※シート「Sheet1」を上書きします。" & Chr(13) & "※上書きしたくない場合は、キャンセルをクリックして下さい。" & Chr(13) & "※実行後、この処理は戻せません。"

' フォルダ選択ダイアログの初期設定

'ダイアログタイトル

strTitle = "ファイル名を取得したいフォルダを選択して下さい"

'ダイアログの初期パスをモジュール起動エクセルに設定

strInitialPath = ActiveWorkbook.Path

' フォルダ選択ダイアログ表示

Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

With objFileDialog

'タイトル

.Title = strTitle

'初期フォルダパス

.InitialFileName = strInitialPath

If .Show = False Then

'キャンセル時

' GoTo Exit_Function

MsgBox "キャンセルされました。処理を終了します。"

Worksheets("Sheet1").Activate

Range("A1").Select

End

Else

'フォルダパス取得

strPath = .SelectedItems(1)

End If

End With

'画面更新停止

Application.ScreenUpdating = False

'確認ダイアログ停止

Application.DisplayAlerts = False

' 変数定義

Dim lastRow As Long '変数lastRowを整数とする

'変数lastRowにA1セルから見た最下の行数を代入

lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

'セルA2からC列最終行までのセルをクリア

ThisWorkbook.Worksheets("Sheet1").Range(Cells(2, "A"), Cells(lastRow, "F")).ClearContents

Dim FSO As FileSystemObject '変数fsoをファイルやフォルダなどの専用入れ物とする

'変数fsoをインスタンス化

Set FSO = New FileSystemObject

Dim fl As Folder '変数flをフォルダとする

'フォルダを指定

Set fl = FSO.GetFolder(strPath)

Worksheets("Sheet1").Range("A1").Value = "ファイル名（現在）" & vbCrLf & "編集不要"

Worksheets("Sheet1").Range("B1").Value = "拡張子（現在）" & vbCrLf & "編集不要"

Worksheets("Sheet1").Range("C1").Value = "ファイル名+拡張子（現在）" & vbCrLf & "編集不要"

Worksheets("Sheet1").Range("D1").Value = "ファイル名（変更後）" & vbCrLf & "入力欄"

Worksheets("Sheet1").Range("E1").Value = "拡張子（変更後）" & vbCrLf & "編集不要"

Worksheets("Sheet1").Range("F1").Value = "ファイル名+拡張子（変更後）" & vbCrLf & "編集不要"

Dim bname As Object

Set bname = CreateObject("Scripting.FileSystemObject")

Dim f As File '変数fをファイルとする

Dim i As Long: i = 2 '変数iを整数とする、変数iを2整数とする

'書式設定

Columns("F:F").Select

Selection.NumberFormatLocal = "G/標準"

'シートを選択

ActiveSheet.Name = "Sheet1"

'書式設定

Columns("A:F").Select

Selection.ColumnWidth = 19.7

Columns("A:F").EntireColumn.AutoFit

Selection.NumberFormatLocal = "@"

Columns(1).Interior.ColorIndex = 15

Columns(2).Interior.ColorIndex = 15

Columns(3).Interior.ColorIndex = 15

Columns(5).Interior.ColorIndex = 15

Columns(6).Interior.ColorIndex = 15

Worksheets("Sheet1").Range("A1:C1").Interior.ColorIndex = 17

Worksheets("Sheet1").Range("D1").Interior.ColorIndex = 46

Worksheets("Sheet1").Range("E1:F1").Interior.ColorIndex = 6

'フォルダ内のファイルを取得

For Each f In fl.Files

'セルCi（変数）の値に取得したフォルダ名を代入

' Cells(i, 1).Value = f.Name

Cells(i, 1).Value = bname.GetBaseName(f.Path)

Cells(i, 2).Value = bname.GetExtensionName(f.Path)

Cells(i, 3).Value = "=A" & i & "&" & """.""" & "&" & "B" & i

Cells(i, 5).Value = bname.GetExtensionName(f.Path)

Cells(i, 6).Value = "=D" & i & "&" & """.""" & "&" & "E" & i

'変数iに1を加える

i = i + 1

ActiveSheet.Name = "Sheet1"

'書式設定

Columns("C:C").Select

Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _

:=Array(1, 1), TrailingMinusNumbers:=True

'書式設定

Columns("F:F").Select

Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _

:=Array(1, 1), TrailingMinusNumbers:=True

'書式設定

Selection.NumberFormatLocal = "G/標準"

Worksheets("Sheet1").Range("F1").Value = "ファイル名+拡張子（変更後）" & vbCrLf & "編集不要"

Cells(1, 1).Select

Set objFileDialog = Nothing

Set FSO = Nothing

Set fl = Nothing

Set bname = Nothing

'画面表示ON

Application.ScreenUpdating = False

MsgBox "完了しました。処理を終了します。" & Chr(13) & "「Sheet1」シートを確認して下さい。"

Else

MsgBox "「Sheet1」シートがありません。先に「Sheet1」シートを追加して下さい。" & Chr(13) & "処理を終了します。"

End If

'画面更新　停止解除

Application.ScreenUpdating = True

End Sub

Sub main2()

' 変数定義

Dim objFileDialog As Object 'FileDialog

Dim strTitle As String 'タイトル

Dim strPath As String 'フォルダパス

Dim strInitialPath As String '初期フォルダパス

Dim sh As Worksheet, flag As Boolean

Dim rc As Integer

For Each sh In Worksheets

If sh.Name = "Sheet1" Then flag = True

Next sh

If flag = True Then

'シートを選択

Worksheets("Sheet1").Activate

MsgBox "ファイル名を置換したい、フォルダを選択して下さい。" & Chr(13) & Chr(13) & "※ファイル名を上書きします。" & Chr(13) & "※上書きしたくない場合は、キャンセルをクリックして下さい。" & Chr(13) & "※実行後、この処理は戻せません。"

' フォルダ選択ダイアログの初期設定

'ダイアログタイトル

strTitle = "ファイル名を置換したいフォルダを選択して下さい"

'ダイアログの初期パスをモジュール起動エクセルに設定

strInitialPath = ActiveWorkbook.Path

' フォルダ選択ダイアログ表示

Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

With objFileDialog

'タイトル

.Title = strTitle

'初期フォルダパス

.InitialFileName = strInitialPath

If .Show = False Then

'キャンセル時

' GoTo Exit_Function

MsgBox "キャンセルされました。処理を終了します。"

Worksheets("Sheet1").Activate

Range("A1").Select

End

Else

'フォルダパス取得

strPath = .SelectedItems(1)

End If

End With

'画面更新停止

Application.ScreenUpdating = False

'確認ダイアログ停止

Application.DisplayAlerts = False

'変数定義

'変数lastRowを整数とする

Dim lastRow As Long

'変数lastRowにA1セルから見た最下の行数を代入

lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

'変数fsoをファイルやフォルダなどの専用入れ物とする

Dim FSO As FileSystemObject

'変数fsoをインスタンス化

Set FSO = New FileSystemObject

'変数flをフォルダとする

Dim fl As Folder

'フォルダを指定

Set fl = FSO.GetFolder(strPath)

'変数指定fileNameを文字列とする

Dim fileName As String

' Dim bname As Object

' Set bname = CreateObject("Scripting.FileSystemObject")

Dim f As File '変数fをファイルとする

Dim i As Long: i = 2 '変数iを整数とする、変数iを整数2とする

'フォルダ内のファイルを置換

On Error Resume Next

For Each f In fl.Files

fileName = f.Name ' ファイル名の取得

If fileName = Cells(i, 3).Value Then ' ファイル名を変更したいファイル

f.Name = Cells(i, 6).Value ' ファイル名の変更

'変数iに1を加える

i = i + 1

End If

Cells(1, 1).Select

Set objFileDialog = Nothing

Set FSO = Nothing

Set fl = Nothing

' Set bname = Nothing

'画面表示ON

Application.ScreenUpdating = False

MsgBox "完了しました。処理を終了します。" & Chr(13) & "「Sheet1」シートを確認して下さい。" & Chr(13) & Chr(13) & "※ファイル名重複などエラーは無視して、ファイル名置換処理は実行されません。"

Else

MsgBox "「Sheet1」シートがありません。先に「Sheet1」シートを追加して下さい。" & Chr(13) & "処理を終了します。"

End If

'画面更新　停止解除

Application.ScreenUpdating = True

End Sub

Microsoft Scripting Runtimeを有効にする

Microsoft Scripting Runtimeを有効にする方法が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】Microsoft Scripting Runtimeを有効にする方法

マクロを実行

上記で作成したマクロファイル（ここでは「複数のファイル名を一括で取得、置換するエクセルVBA.xlsm」とファイル名を設定。）と、
マクロ実行テスト用のダミーデータとして、エクセルファイルを準備します。

ファイル名を一括取得・置換したいファイルをフォルダに格納する

フォルダを新規作成して、対象ファイルをフォルダに格納します。
※フォルダ名は任意です。例として「ファイル名を一括で取得、置換するテストフォルダ」と入力しています。

マクロを実行してファイル名を一括取得する

マクロファイルを開いて、「コンテンツの有効化」をクリックします。
※設定により、「コンテンツの有効化」は表示されない（クリック不要の）場合もあります。

「開発」タブをクリックします。

「マクロ」をクリックします。

「main」→「実行」をクリックします。

メッセージが表示されるので確認して「OK」をクリックします。

ファイル名を一括取得したいファイルが格納されているフォルダを選択→「OK」をクリックします。

メッセージが表示されるので確認して「OK」をクリックします。

マクロを実行したファイルのシートにファイル名の一覧が作成されます。

マクロを実行してファイル名を一括置換する

ファイル名一覧のD列に置換後のファイル名を入力します。

「開発」タブをクリックします。

「マクロ」をクリックします。

「main2」→「実行」をクリックします。

メッセージが表示されるので確認して「OK」をクリックします。

ファイル名を一括置換したいファイルが格納されているフォルダを選択→「OK」をクリックします。

メッセージが表示されるので確認して「OK」をクリックします。

フォルダ内のファイル名が置換されます。

完了です。