VBScriptでフォルダ配下のファイルを全削除する


気ままに更新しています。今日はVBScriptの話題です。
VBScriptはMicrosoftのスクリプト言語です。私の身近では全然流行っていませんが、Excel VBA からプログラミングを始めた私にとってはとても書きやすい言語なので、日々の仕事を便利にするために時々使っています。Windows PCでの繰り返し作業の自動化をするときとても便利です。

今日は、指定したフォルダの(サブフォルダを含む)中の.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"」を好きな拡張子に変えることで削除対象の拡張子を変更できます。

COMMENTS

名前

Android,8,Excel,3,GIMP,5,Inkscape,3,iPhone,1,Kindle,2,PC,4,Thinkpad X240,1,Thinkpad X260,2,TOEFL,1,TOEIC,4,VBA,4,VBScript,2,Windows 10,1,インターネットバンキング,1,デザイン,1,圧縮&解凍,2,英語,8,雑感,1,資格,13,情報処理技術者試験,5,電子書籍,2,読書,1,簿記,2,
ltr
item
勉強とガジェット: VBScriptでフォルダ配下のファイルを全削除する
VBScriptでフォルダ配下のファイルを全削除する
https://2.bp.blogspot.com/-XPJO8b0UBj4/WENQ_lNnj8I/AAAAAAABwNQ/n9iQhFHnNaQ5FsBHXOS4IXKJN7jFUU-cgCLcB/s400/garbage-can-1111448_1920.jpg
https://2.bp.blogspot.com/-XPJO8b0UBj4/WENQ_lNnj8I/AAAAAAABwNQ/n9iQhFHnNaQ5FsBHXOS4IXKJN7jFUU-cgCLcB/s72-c/garbage-can-1111448_1920.jpg
勉強とガジェット
http://tanaka-misaki.blogspot.com/2011/12/vbscript.html
http://tanaka-misaki.blogspot.com/
http://tanaka-misaki.blogspot.com/
http://tanaka-misaki.blogspot.com/2011/12/vbscript.html
true
8692194293250221214
UTF-8
Loaded All Posts Not found any posts VIEW ALL Readmore Reply Cancel reply Delete By Home PAGES POSTS View All RECOMMENDED FOR YOU LABEL ARCHIVE SEARCH ALL POSTS Not found any post match with your request Back Home Sunday Monday Tuesday Wednesday Thursday Friday Saturday Sun Mon Tue Wed Thu Fri Sat January February March April May June July August September October November December Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec just now 1 minute ago $$1$$ minutes ago 1 hour ago $$1$$ hours ago Yesterday $$1$$ days ago $$1$$ weeks ago more than 5 weeks ago Followers Follow THIS CONTENT IS PREMIUM Please share to unlock Copy All Code Select All Code All codes were copied to your clipboard Can not copy the codes / texts, please press [CTRL]+[C] (or CMD+C with Mac) to copy