ユーザープロファイルのダウンロードフォルダ配下を全て削除するVBScript

12月 30, 2022

ユーザープロファイルの「Downloads」フォルダ配下は、なにかと不要ファイルが溜まりがちです。（人によるとは思いますが。）

筆者もその不要ファイルが溜まってしまう人のひとりです。

今回はスタートアップ時、またはログイン、ログオフスクリプトによって「Downloads」フォルダ配下のフォルダ・ファイルを全て削除する仕組みを作ります。

VBScriptでダウンロードフォルダ配下のフォルダ・ファイルを全て削除

なぜVBSで作ったか？

最初はバッチファイル ( bat ) で作ろうと思ったのですが、バッチファイルを起動すると黒いコマンドプロンプトのウィンドウが出てきてしまいます。

黒いコマンドの画面、ユーザーに見せたくはないですよね。

バッチファイルのウィンドウを消そうとするとVBSを使うのですが、

「どうせVBS使うなら最初からVBSで作ってしまったほうが良くない？」

との発想に至りました。

ソースコード

以下となります。

On Error Resume Next

Dim objWs        'WScript.Shellオブジェクト
Dim objFso       'FileSystemObjectオブジェクト

Dim userFldPath  'ユーザーフォルダパス
Dim dlFldPath    'Downloadsフォルダパス

Dim objFolder    'Downloadsフォルダ
Dim objSubFolder 'Downloadsフォルダ配下のフォルダ
Dim objFile      'Downloadsフォルダ配下のファイル

' Downloadsフォルダパスを取得
Set objWs = CreateObject("WScript.Shell")
userFldPath = objWs.ExpandEnvironmentStrings("%USERPROFILE%")
dlFldPath = userFldPath & "\Downloads"

' FileSystemObjectオブジェクトを取得
Set objFso = CreateObject("Scripting.FileSystemObject")

' Downloadsフォルダが存在する場合のみ削除処理を実施
If objFso.FolderExists(dlFldPath) Then

    ' Downloadsフォルダを取得
    Set objFolder = objFso.GetFolder(dlFldPath)

    ' Downloadsフォルダ配下のフォルダを全て削除
    For each objSubFolder in objFolder.SubFolders
        objFso.DeleteFolder dlFldPath & "\" & objSubFolder.Name, True
    Next

    ' Downloadsフォルダ配下のファイルを全て削除
    For each objFile in objFolder.Files
        objFso.DeleteFile dlFldPath & "\" & objFile.Name, True
    Next
End If

Set objFso = Nothing
Set objWs = Nothing

エラーが起きてもユーザーにはエラーが起きたことを見せたくないので「On Error Resume Next」を使用しています。

例えば、ファイルがなんらかのアプリによって掴まれていた場合、削除することができずエラーを出力してしまうので、それの防止です。

これをスタートアップに仕込むことで「Downloads」フォルダ配下のフォルダ・ファイルがログイン後に全て削除されます。

端末がAD管理下の場合、ログイン、ログオフスクリプトに仕込むことでも削除することができます。

以上となります。

ここまでお読みいただきありがとうございました。

VisualBasic

Posted by だゆう