Excel VBAを活用して購読解除メールを自動削除する方法

この記事では、Excel VBAを使って購読を解除したニュースレターやサービスからのメールを自動で削除する方法について解説します。まず基本的なコードの作成から、詳細な解説、そして応用例に至るまで、一通りの手法を紹介していきます。

基本コード

Sub DeleteUnsubscribedEmails()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olItem As Object
    Dim i As Integer

    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(6) 'Inbox

    For i = olFolder.Items.Count To 1 Step -1
        Set olItem = olFolder.Items(i)
        If InStr(1, olItem.Subject, "購読解除") Or InStr(1, olItem.Subject, "Unsubscribe") Then
            olItem.Delete
        End If
    Next i
End Sub

コードの解説

1. まずOutlookのオブジェクトを設定します。
2. その後、Outlookのネームスペース（MAPI）を取得します。
3. 受信トレイを指定します。
4. 受信トレイ内のすべてのメールに対してループ処理を行います。
5. メールの件名に「購読解除」または「Unsubscribe」が含まれている場合、そのメールを削除します。

応用例

1. 特定の日付より古い購読解除メールの削除

Sub DeleteOldUnsubscribedEmails()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olItem As Object
    Dim i As Integer
    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(6) 'Inbox
    For i = olFolder.Items.Count To 1 Step -1
        Set olItem = olFolder.Items(i)
        If (InStr(1, olItem.Subject, "購読解除") Or InStr(1, olItem.Subject, "Unsubscribe")) And olItem.ReceivedTime < Date - 30 Then
            olItem.Delete
        End If
    Next i
End Sub

解説

このコードは、基本コードと同じロジックを使用しますが、30日以上前に受信した「購読解除」メールのみを対象に削除します。

2. 購読解除メールを特定のフォルダに移動

Sub MoveUnsubscribedEmailsToFolder()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olTargetFolder As Object
    Dim olItem As Object
    Dim i As Integer

    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(6) 'Inbox
    Set olTargetFolder = olFolder.Folders("購読解除メール")

    For i = olFolder.Items.Count To 1 Step -1
        Set olItem = olFolder.Items(i)
        If InStr(1, olItem.Subject, "購読解除") Or InStr(1, olItem.Subject, "Unsubscribe") Then
            olItem.Move olTargetFolder
        End If
    Next i
End Sub

解説

このコードは、購読解除メールを削除する代わりに、"購読解除メール"という名前のフォルダに移動します。

3. 購読解除メールにフラグを立てる

Sub FlagUnsubscribedEmails()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olItem As Object
    Dim i As Integer

    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(6) 'Inbox

    For i = olFolder.Items.Count To 1 Step -1
        Set olItem = olFolder.Items(i)
        If InStr(1, olItem.Subject, "購読解除") Or InStr(1, olItem.Subject, "Unsubscribe") Then
            olItem.FlagStatus = 2 'Flagged
        End If
    Next i
End Sub

解説

このコードは、購読解除メールに特定のフラグを立てるものです。後で手動で確認または処理できるようになります。

まとめ

Excel VBAを活用して購読解除メールの管理を自動化することで、受信トレイの整理が容易になります。上記の基本的なコードをベースに、自分のニーズに合わせてカスタマイズすることが可能です。VBAの利用により、より効率的なメール管理を実現しましょう。