目的

メールの処理が苦痛です。（正確には苦痛でした。）
前の職場では１日に２５０通くらいのメールを受信していました。
今は１日に１０通も受信しない日があるくらいで、逆にメールを確認しなさ過ぎてうっかり頼まれごとを忘れる（というか気づいていない）事も有ったり…

動作単位でボタンを作成して、わずらわしい操作を無くしていきたいと思います。
メール転送とフォルダ移動のボタン作成します。

メール処理の自動化のカタチ

メール処理の自動化を最初に考えた時は、色々考えました。

タスクになりそうなものを自動抽出…
スレッド機能から自然言語処理…

しかし、難しいばかりか、プログラム実行後の後処理として今までなかった操作の発生など、どうしても複雑化していってしまい、どれも成功とは言えませんでした。

そこで、ボタンが増えるというのを我慢して、あえてボタン１つの動作を小さい範囲の動作として、どのボタンをクリックするかは判断する方向のカスタマイズを行い、少なからず、完全自動化を目指した時よりは成功に近づいたと思っています。
一例としてメール転送とフォルダ移動のボタン作成とソースコードを載せます。

まず、図１のVBE画面からソースコードを書いていきます。

図１ VBE 画面

メール転送

私のメーラーは Microsoft Outlook です。
メール転送は『Ctrl ＋ F』のショートカットキーが割り当てられています。
しかし、メール転送で１番メンドウと感じている操作は E-Mail Address の入力欄をマウスでクリックする事と E-Mail Address の入力だと思っています。

ソースコード①
〜メール転送〜

このソースコードはグループメンバーに展開する必要のあるメールを見つけた時に、ボタン１つで転送することを想定したプログラムです。

GrMemberという変数でE-Mail Addressを指定しています。
ここは書き換えて使ってください。

転送本文という変数でメール本文を指定しています。
だいぶ素っ気ないので、ここも書き換えて使ってください。

『.Send』のところはPCの設定上、Microsoft Outlook から警告ダイアログが表示されると思いますが、 VBA セキュリティの設定を変更すると警告無く動作するかと思います。

ですが、セキュリティ設定変更は推奨しないので、コメントアウトして、転送メールが表示された後、『Alt + S』で送信することをオススメ致します。


Public Const GrMember = "**********@****.co.jp; **********@****.co.jp; **********@****.co.jp; **********@****.co.jp"
Public Const 転送本文 = "各位" & vbNewLine & vbNewLine & "転送します。確認ください。"
 
Sub メール転送()
    
    ' 選択アイテム数の取得
    選択アイテム数 = Application.ActiveExplorer.Selection.Count
   
    ' 選択アイテムの処理
    For i = 1 To 選択アイテム数
       
        ' アイテムの取得
        Set olItem = Application.ActiveExplorer.Selection.Item(i)
       
        ' アイテム種類の取得
        アイテム種類 = TypeName(olItem)
       
        ' アイテム種類がメールなら
        If アイテム種類 = "MailItem" Then
           
            Set Fw = olItem.Forward
               
            With Fw
               
                .Display
                .To = GrMember
                .Body = 転送本文 & vbNewLine & .Body
                .Send
               
            End With
           
        End If
       
    Next i
   
End Sub

フォルダ移動

Microsoft Outlook でメールをフォルダ移動する時は、移動させたいメールを選択して、移動先のフォルダにドラッグ & ドロップするとメールのフォルダ移動が出来ます。
私はこの操作が嫌いです。
ドラッグ距離が長く、たまに全然違うフォルダに移動させてしまうからです。

ソースコード②
〜フォルダ移動〜

このソースコード②はソースコード①で書いたプログラムで転送した後に実行することを想定しています。

フォルダ移動はメンドウですが、フォルダ１つに対して１プログラムとしてます。

以下の２つを変更すれば移動させるフォルダを変更できます。
"作成日：2017-10-02" (データファイル名)
"周知事項" (データファイル内、フォルダ名)


Sub 周知事項フォルダへ移動()
   
    ' 選択アイテム数の取得
    選択アイテム数 = Application.ActiveExplorer.Selection.Count
   
    ' 選択アイテムの処理
    For i = 1 To 選択アイテム数
       
        ' アイテムの取得
        Set olItem = Application.ActiveExplorer.Selection.Item(i)
       
        ' アイテム種類の取得
        アイテム種類 = TypeName(olItem)
       
        ' アイテム種類がメールなら
        If アイテム種類 = "MailItem" Then
           
            Set 移動先フォルダ = Application.Session.Folders("作成日：2017-10-02").Folders("周知事項")
            olItem.Move 移動先フォルダ
           
        End If
       
    Next i
   
End Sub