このサイトの記事内では「アフィリエイト広告」などの広告を掲載している場合があります。
消費者庁が問題としている「誇大な宣伝や表現」とならないよう配慮しコンテンツを制作しておりますのでご安心ください。
問題のある表現が見つかりましたらお問い合わせよりご一報いただけますと幸いです。

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

2024年3月8日

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

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

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

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

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

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

VBAが難しいと感じたら
ココナラにてマクロ(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

Posted by やろまい