【Outlook VBA】仕分けをワイルドカード付きのタイトルで行う

Outlookの仕分け機能ってとても便利ですよね。

メールアドレスやタイトルに応じて、メールを自動的にフォルダへ振り分けしてくれます。

ただ、ちょっと困るのが仕訳ルールを細かく設定できないことです。

タイトルだと「特定の文字を含む」という設定はできるのですが、「特定の文字から始まる」といった設定をすることができません。

タイトルの先頭が「Re:」があるといった細かな設定ができないのです。

Outlookのデフォルト機能では対処できないため、今回はOutlook VBAにて実現する方法を紹介します。

仕分けをワイルドカード付きのタイトルで行うプログラム

Option Explicit

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    
    ''【test】*というタイトルのメールをtestフォルダに仕分ける
    MoveMail EntryIDCollection, "test", "【test】*"
End Sub

Sub MoveMail(entryID As String, strFldrName As String, titleWithWild As String, Optional strAddress = "")
    '''strFldrName:移動させるフォルダ名
    '''titleWithWild:ワイルドカード付きのタイトル
    
    Dim myNameSpace As NameSpace
    Set myNameSpace = GetNamespace("MAPI")
    
    ''移動先のフォルダ取得
    On Error GoTo NoFldr
    Dim myInbox As Outlook.Folder
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders.Item(strFldrName)
    On Error GoTo 0
    
    Dim itemMail As Outlook.MailItem
    Set itemMail = myNameSpace.GetItemFromID(entryID)
    
    ''タイトルがマッチしなければ早期Rtn
    If Not (itemMail.Subject Like titleWithWild) Then Exit Sub
    
    If strAddress = "" Or strAddress = GetSenderEmailAddress(itemMail) Then
        itemMail.Move myInbox
    End If
    
NoFldr:
End Sub

Private Function GetSenderEmailAddress(ByRef oItem As MailItem) As String
    '''送信者のメールアドレスを取得する
    '''「アルパカのメモ」様より引用
    '''https://vicugna-pacos.github.io/vba/outlook/sender-email-address/

    Dim PR_SMTP_ADDRESS  As String
    Dim oSender As AddressEntry
    Dim oExUser As ExchangeUser
    
    
    PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    
    ' Exchange 以外
    If oItem.SenderEmailType <> "EX" Then
        GetSenderEmailAddress = oItem.SenderEmailAddress
        Exit Function
    End If
    
    Set oSender = oItem.Sender
    
    If oSender.AddressEntryUserType = olExchangeUserAddressEntry _
        Or oSender.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
        
        Set oExUser = oSender.GetExchangeUser
        GetSenderEmailAddress = oExUser.PrimarySmtpAddress
        Exit Function
    End If
    
    GetSenderEmailAddress = oSender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)

End Function
ThisOutlookSession

OutlookのVBEを開き、このプログラムをThisOutlookSessionに貼り付けるとワイルドカード付きのタイトルで仕分けを行うことができます。
(Outlookを開いた状態でAlt+F11を押すとVBEが開きます)

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    
    ''【test】*というタイトルのメールをtestフォルダに仕分ける
    MoveMail EntryIDCollection, "test", "【test】*"
End Sub

仕分けの条件は「Application_NewMailEx」というプロシージャで指定します。

サンプルプログラムでは「【test】*」というタイトルのメールを受信したら、自動的にtestフォルダに仕分けするように指定しています。

【test】の後に*を入れているため、タイトルの先頭が【test】だと仕分けされます。

受信フォルダの配下にtestフォルダを作成

このタイトルとフォルダ名は目的に合わせて自由に書き換えてください。

ただし、メールを仕分けるフォルダは受信トレイの配下に作成してください。
(受信トレイとフォルダがツリーの同じ階層だとうまくいきません)

メール送信者の指定も可能

    MoveMail EntryIDCollection, "test", "【test】*", "xxx@xxx"

サンプルコードでは指定していませんが、上のように引数の最後にメールアドレスを追加すると仕分け条件に送信者も追加することができます。

タイトルと送信者の両方を仕分け条件としたい時に使ってください。
※送信者のメールアドレスを取得する方法(GetSenderEmailAddress)は「アルパカのメモ」様よりコードを引用させていただいております。

VBAが難しいと感じたら
プロにお任せして代わりに作ってもらってはいかがでしょう?
こちらの記事でおすすめのプログラマーを紹介しています

《VBA中級者向けの本》
VBA上級者を目指したい人にはパーフェクトExcel VBA一択です。

created by Rinker
技術評論社
¥3,608 (2022/10/01 13:30:59時点 Amazon調べ-詳細)

他の「VBA」の記事はこちらからどうぞ

VBA

Posted by やろまい