Becky! で だいたい○日前のメールを削除する

beckey_delete.vbs

Option Explicit

'----------------------------------------------------------
'変数定義
'----------------------------------------------------------
Dim objFileSys
Dim objIE
Dim objSubf
Dim objSubd
Dim strArray
Dim strDeleteFile
Dim strDeleteFolder
Dim strAnswer
Dim strInputCtime
Dim dateCtimeFile
Dim dateCtimeFolder
Dim i

'----------------------------------------------------------
' 削除対象のメールデータがあるディレクトリ
'----------------------------------------------------------
strArray = Array("C:\Becky!\454294dd.mb\!!!!Inbox", _
                 "C:\Becky!\454294dd.mb\!Trash")


'----------------------------------------------------------
'オブジェクト定義
'----------------------------------------------------------
Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set objIE      = WScript.CreateObject("InternetExplorer.Application")

'----------------------------------------------------------
' 削除処理
'----------------------------------------------------------
strAnswer = MsgBox ("削除処理を開始します。", vbYesNo , "削除ファイル確認" )
Select Case strAnswer
  Case vbYes

    '----------------------------------------------------------
    ' objIEの初期設定
    '----------------------------------------------------------
    objIE.Navigate "about:blank"
    While objIE.busy: Wend
    While objIE.Document.readyState <> "complete": DoEvents : Wend
    objIE.AddressBar     = False
    objIE.ToolBar        = False
    objIE.StatusBar      = False
    objIE.Resizable      = False
    objIE.Height         = 100
    objIE.Width          = 600
    objIE.Top            = 50
    objIE.Left           = 0
    objIE.Visible        = True
    objIE.Document.Title = "[VBScript] Becky! ファイル削除モニタ"

    '--- 削除日数確認処理
    strInputCtime     = InputBox("何日前のファイルを削除しますか？" & vbCr & "(デフォルト7日)", "削除日指定", 7)
    If strInputCtime = "" Then
        MsgBox "キャンセル終了"
        objIE.Quit
        WScript.Quit
    End If

    '--- 削除処理
    For i = 0 To UBound(strArray)

        '--- メールデーターの削除
        if objFileSys.FolderExists(strArray(i)) then

            '--- 削除対象ディレクトリからファイル名取得
            Set objSubf = objFileSys.GetFolder(strArray(i))
            For Each strDeleteFile In objSubf.Files
            
                '--- ファイル作成日取得
                dateCtimeFile = strDeleteFile.DateLastModified
                
                '--- strInputCtime日前のファイルは削除
                if Cint(DateDiff("d", dateCtimeFile, date)) >= Cint(strInputCtime) then
                    objIE.Document.body.innerHTML = "<b><font color=red>削除中</font></b><br>" & strDeleteFile
                    objFileSys.DeleteFile strDeleteFile, True
                    Set strDeleteFile   = Nothing
                End if
            Next
        End if
        
       '--- 添付ファイルの削除
        if objFileSys.FolderExists(strArray(i) & "\#Attach") then

            '--- 削除対象ディレクトリからディレクトリ名取得
            Set objSubd = objFileSys.GetFolder(strArray(i) & "\#Attach")
            For Each strDeleteFolder In objSubd.Subfolders
            
                '--- ディレクトリ作成日取得
                dateCtimeFolder = strDeleteFolder.DateLastModified
                
                '--- strInputCtime日前のディレクトリは削除
                if Cint(DateDiff("d", dateCtimeFolder, date)) >= Cint(strInputCtime) then
                    objIE.Document.body.innerHTML = "<b><font color=red>削除中</font></b><br>" & strDeleteFolder
                    objFileSys.DeleteFolder strDeleteFolder, True
                    Set strDeleteFolder = Nothing
                End if
            Next
        End if
    Next

  Case vbNo
    MsgBox "キャンセル終了"
    WScript.Quit
    
End Select

'----------------------------------------------------------
' 後処理
'----------------------------------------------------------
objIE.Quit

Set objFileSys = Nothing

MsgBox "終了"