指定した拡張子のファイルをすべて削除

タイトルのマクロです。

'*****************************
'* 指定した拡張子のファイルをすべて削除
'* folderPath:削除するファイルの保管フォルダ
'* fileExtension:削除する拡張子
Private Sub DeleteFilesExtension(ByVal folderPath As String, ByVal fileExtension As String)
    ' 確認メッセージ
    Dim confirmation As VbMsgBoxResult
    confirmation = MsgBox("フォルダ '" & folderPath & "' に保管されている。拡張子 " _
                    & fileExtension & " のファイルすべて削除してもよいですか?", _
                    vbYesNo + vbExclamation, "確認")
    ' Noが選択された場合に終了
    If confirmation = vbNo Then Exit Sub
    
    ' 参照設定にかかわらず、以下は使用可能
    ' 参照設定:Microsoft Scripting Runtime
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim myFiles As Object
    Dim myFile As Object
    Set myFiles = FSO.GetFolder(folderPath).Files
    
    Dim fileExtensionLen As Long    ' 拡張子の文字数
    fileExtensionLen = Len(fileExtension)
    
    Dim cnt As Long ' 完了メッセージ用、削除したファイル数
    
    ' すべてのファイルを処理
    For Each myFile In myFiles
        If Right(myFile.Name, fileExtensionLen) = fileExtension Then
            FSO.DeleteFile myFile
            cnt = cnt + 1
        End If

    Next myFile
    Set FSO = Nothing
    
    MsgBox "マクロ終了。削除されたファイル数:" & cnt

End Sub

参照設定しなくても使用できます。使用例は、以下です。

Private Sub 使用例()
    Call DeleteFilesExtension("C:\TEMP", ".xls")
End Sub

このマクロを実行すると、”C:\TEMP”内に保管されている拡張子”.xls”のファイルをすべて削除します。削除前に、確認メッセージが表示され、確認後削除します。マクロ完了時、削除されたファイル数が表示されます。

Follow me!