コメントで以下のようなご要望をいただきました。
迷惑メールフォルダ内にたまったメールを手動にて「受信拒否リストに追加」して
おります。この操作をマクロにて実現可能でしょうか?
以下のようなマクロで可能です。なお、このマクロを実行した後、Outlook を再起動すると受信者拒否リストに追加されます。
' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub AddSpammerToList()
Const BLOCK_SENDERS_LIST = "c:\temp\blocksenders.txt"
Const OFFICE_KEY = "HKCU\Software\Microsoft\Office\"
Const OPTIONS_KEY = ".0\Outlook\Options\Mail\"
Dim strOptionKey As String
Dim fldSpam As Folder
Dim objMail 'As MailItem
Dim strSenders As String
Dim objFSO
Dim stmList
' 拒否リストを作成
strSenders = ""
Set fldSpam = Session.GetDefaultFolder(olFolderJunk)
For Each objMail In fldSpam.Items
If TypeName(objMail) = "MailItem" Then
If InStr(strSenders, objMail.SenderEmailAddress) = 0 And _
InStr(objMail.SenderEmailAddress, "@") > 0 Then
strSenders = strSenders & objMail.SenderEmailAddress & vbCrLf
End If
End If
Next
' 拒否リストをファイルに書き込み
Open BLOCK_SENDERS_LIST For Output As #1
Print #1, strSenders
Close #1
' レジストリで拒否リストの読み込みを指定
Set WshShell = CreateObject("WScript.Shell")
strOptionKey = OFFICE_KEY & Left(Application.Version, 2) & OPTIONS_KEY
WshShell.RegWrite strOptionKey & "JunkMailBlockedSendersFile", BLOCK_SENDERS_LIST, "REG_SZ"
WshShell.RegWrite strOptionKey & "JunkMailImportLists", 1, "REG_DWORD"
WshShell.RegWrite strOptionKey & "JunkMailImportAppend", 1, "REG_DWORD"
End Sub
うまく動作させる事が出来ました。
Const BLOCK_SENDERS_LIST = “c:\temp\blocksenders.txt”
私の環境ではドライブ文字が違ったのでここだけ変更が必要でした。
悩んでいる人は多いかと…。
IMAPに対しても動作できる方法がありましたら
ご享受ください。