Outlook 注文メール受信時に、担当者に自動転送したい

こんにちは！受信メールを関係者に転送しまくってるtknriaです！


OUTLOOKには「転送」ボタンがあるので、転送先を指定すればすぐ転送できるのですが、如何せん手間！

しかも転送してるメールも、転送先も、毎回同じやし！


ってことで、特定のメールを受信したときに、特定の人に毎回転送する作業を自動化しちゃいます。

■ 自動転送してみる

以下にVBAコード例を挙げます。


転送する際に、

・転送対象のメールの件名はorder_sub
・Toに入れる人の名前はname_JUCHU
・Toに入れる人のメールアドレスはaddress_JUCHU
・Ccに入れる人の名前はname_HASSOU
・Ccに入れる人のメールアドレスはaddress_HASSOU
・本文冒頭に入れる文章はfw_scrp

に従って、メールがつくられます。


今回は、「注文メール」という件名のメールを受信したときに、指定した2名に自動転送するという設定にしています。

' ----- 以下、ソース -----

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim objItem As Variant
    Set objItem = Session.GetItemFromID(EntryIDCollection)
    If TypeName(objItem) = "MailItem" The
        ' 関係各位に自動転送
        Call ForwardOrderMail(objItem)
    End If

End Sub


Public Sub ForwardOrderMail(ByVal objMail As MailItem)
    Const name_JUCHU = "tknr1さん"  ' 受注管理者名
    Const address_JUCHU = "okku@hosomichi.com"   ' 受注管理者アドレス
    Const name_HASSOU = "tknr2さん" ' 発送担当者名
    Const address_HASSOU = "hosomichi@okku.com"  ' 発送担当者アドレス
    Const order_sub = "注文メール"  ' 注文メールかどうかを判別する件名
    Const fw_scrp = "自動転送しています。"  ' 転送メールの冒頭に追記する文
   
    If objMail.Subject = order_sub Then
        Dim fwMail As MailItem
        Set fwMail = objMail.Forward
       
        Dim Rec As Recipient
        Set Rec = fwMail.Recipients.Add(name_JUCHU & "<" & address_JUCHU & ">")
        Rec.Type = olTo
        Set Rec = fwMail.Recipients.Add(name_HASSOU & "<" & address_HASSOU & ">")
        Rec.Type = olCC
        Rec.Resolve
       
        fwMail.Body = fw_scrp & vbCrLf & vbCrLf & fwMail.Body
        fwMail.Send
    Else
    End If
End Sub

' ----- 以上、ソース -----

■ 億劫なあとがき

これで自動転送は完璧！

自分宛にテストしようとすると、自分宛に送信して自分で受信して自分宛に自動転送されて自分で受信する形になって、自分大好きなんですね！って言われちゃいます。

是非友達や同僚の方に頼んでみてください。