Excelマクロ・VBA 指定フォルダ内のファイルを一括削除する方法
Excel特有の用事ではありませんが、
特定のフォルダ内のファイルを一括削除したい場合があります。
そのような時に便利なブックとマクロ・VBAを紹介します。
目次
サンプルファイル
使用方法
「実行」シートで行いたい処理、「ゴミ箱へ移動」か「削除」を選択し
「実行」ボタンを押下すると選択ダイアログが表示されるので
ファイル削除を表示したいフォルダを選択します。
※「削除」を実行したファイルを復元できない点ご注意ください。
選択ダイアログで「OK」ボタンを押下すると「結果」シートに選択したフォルダと
削除したファイルの一覧、ファイル数が表示されます。
コードサンプルと説明
ファイル一括削除だけなら先述の手順だけでよいですが
カスタマイズしたい方やマクロの中身を知りたい方向けに
ソースコードの説明は下記のとおりです。
Option Explicit
' API用の引数構造体
Private Type SHFILEOPSTRUCT
hwnd As Long 'ウィンドウハンドル
wFunc As Long '実行する操作
pFrom As String '対象ファイル名
pTo As String '目的ファイル名
fFlags As Integer 'フラグ
fAnyOperationsAborted As Long '結果
hNameMappings As Long 'ファイル名マッピングオブジェクト
lpszProgressTitle As String 'ダイアログのタイトル
End Type
' ゴミ箱に入れるAPI
Private Declare Function SHFileOperation Lib "shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Dim exeSheet As Worksheet
Dim resultSheet As Worksheet
Dim dirPath As String '検索対象フォルダを格納する変数
Sub ClickDeleteButton()
Set exeSheet = Worksheets("実行")
Set resultSheet = Worksheets("結果")
' 削除対象ファイルの一覧を表示
Call DirSet
' 実行シートの選択値によって処理を変える
If exeSheet.Range("C5").Value = 1 Then
Call MoveTrash ' ゴミ箱に移動
ElseIf exeSheet.Range("C5").Value = 2 Then
Call Delete ' 完全削除
End If
MsgBox "完了しました。"
End Sub
Sub Delete()
If dirPath <> "" Then
Dim fileName As String
fileName = dir(dirPath & "*.*") ' 1ファイル目を取得
' 全ファイル名を繰り返す
Do While fileName <> ""
'指定ファイルを完全削除
Kill dirPath & fileName
fileName = dir() ' 次のファイル名を取得(無ければ空白)
Loop
End If
End Sub
Sub MoveTrash()
Dim sh As SHFILEOPSTRUCT
Dim result As Long
If dirPath <> "" Then
Dim fileName As String
fileName = dir(dirPath & "*.*") ' 1ファイル目を取得
' 全ファイル名を繰り返す
Do While fileName <> ""
'指定ファイルをごみ箱移動
With sh
.hwnd = Application.hwnd
.wFunc = &H3
.pFrom = dirPath & fileName
.fFlags = &H40
End With
result = SHFileOperation(sh)
fileName = dir() ' 次のファイル名を取得(無ければ空白)
Loop
End If
End Sub
Sub DirSet()
'初期化：既入力値を削除
resultSheet.Range("A2").ClearContents
resultSheet.Range("A4:A10004").ClearContents
'フォルダ選択ダイアログを開く
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = 0 Then
'キャンセルされたので終了
Exit Sub
Else
' 指定されたのでフォルダパスを取得
dirPath = .SelectedItems(1) & "\"
resultSheet.Range("A2").Value = dirPath ' フォルダパスを実行シートに記載
End If
End With
Dim i As Integer
i = 4 ' ファイル表示のループカウンタ(4行から開始)
Dim fileName As String
fileName = dir(dirPath & "*.*") ' 1ファイル目を取得
' 全ファイル名を繰り返す
Do While fileName <> ""
resultSheet.Cells(i, 1).Value = fileName ' ファイル名を実行シートに記載
fileName = dir() ' 次のファイル名を取得(無ければ空白)
i = i + 1
'1万件を超えた場合、終了
If i > 10004 Then
Exit Do
End If
Loop
' 実行シートに移動
resultSheet.Activate
resultSheet.Cells(1, 1).Activate
End Sub