VBScriptでフォルダ配下のファイルのみを全削除する（フォルダ構造は維持）

VBScriptを使い、指定したフォルダおよびそのサブフォルダの中の.txtファイルをすべて削除するプログラムを紹介します。指定したフォルダのサブフォルダ、そのまたサブフォルダ……というフォルダ構造は削除せず維持します。

このプログラムを実行するには、テキストファイルに下記のソースを貼り付け、拡張子「.vbs」で保存し、保存したファイルをダブルクリックしてください。フォルダ選択画面が表示され、フォルダを選択すると実行可否を尋ねるダイアログが表示されます。非常に危険なので、ダイアログのボタンの既定値は「いいえ」にしてあります。

「はい」をクリックすると、指定したフォルダ、そのすべてのサブフォルダ、そのすべてのサブフォルダ……の中の.txtファイルがすべて削除され、終了後にメッセージ「ファイル削除が完了しました」が表示されます。このメッセージは、削除対象のファイルが全くない場合など、削除を実施していない時にも表示されます。

本ブログラムの実行結果に作者は責任を持ちません。大事なファイルがあるフォルダは絶対に指定しないでください。対象ファイルが読み取り専用属性の場合など、ファイルを削除できない場合もあります。また、大量のサブフォルダやファイルがあるフォルダを指定すると、PCがフリーズする可能性があります。

Option Explicit
Private Const TARGET_EXTENTION = "txt"
Call main

Sub main()
    Dim baseFolderPath
    
    baseFolderPath = selectForder
    If baseFolderPath = "" Then
        Exit Sub
    End If
    
    If MsgBox("下記のフォルダの配下、サブフォルダの配下にある「" _
            & TARGET_EXTENTION & "」ファイルをすべて削除します。" _
            & "ごみ箱への移動ではなく削除です。" _
            & vbCrLf & "本当によろしいですか？ " _
            & "（この操作は取り消しできません）" _
            & vbCrLf & vbCrLf & baseFolderPath _
            , vbYesNo + vbCritical + vbDefaultButton2) = vbNo Then
        Exit Sub
    End If
    
    Call deleteFiles(baseFolderPath)
    
    Call MsgBox("ファイル削除が完了しました。", vbInformation)
End Sub

Private Function selectForder()
    Dim objShell
    Dim objFolder
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "配下の「" _
            & TARGET_EXTENTION & _
            "」ファイルを削除したいフォルダを選択してください。", 0)
    
    selectForder = ""
    If Not objFolder Is Nothing Then
        selectForder = objFolder.Items.Item.Path
    End If
    
    Set objShell = Nothing
    Set objFolder = Nothing
End Function

Private Sub deleteFiles(baseFolderPath)
    Dim FSO
    Dim baseFolder
    Dim tempFile
    Dim tempFolder
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set baseFolder = FSO.getFolder(baseFolderPath)
    
    For Each tempFile In baseFolder.Files
        If FSO.GetExtensionName(tempFile.Name) = TARGET_EXTENTION Then
            On Error Resume Next
            tempFile.Delete
            On Error GoTo 0
        End If
    Next
    
    For Each tempFolder In baseFolder.SubFolders
        Call deleteFiles(tempFolder)
    Next
    
    Set FSO = Nothing
    Set tempFile = Nothing
    Set tempFolder = Nothing
End Sub

このプログラムは、「call main」を削除すると、そのままExcel VBAに貼り付けられます。
また、「TARGET_EXTENTION = "txt"」の「"txt"」を好きな拡張子に変えることで削除対象の拡張子を変更できます。