Outlook で送信前チェック

パソコン関連

私はもう2011年からフリーランスで仕事をしています。

最近ものすごく驚いたんですが、
2011年から仕事をいただいている会社(私の前職です)から、

納品のときのメールにはこのアドレスを含めてください

と言われたんです。
そのアドレスは前から知っていたんですが、
納品の時のメールに含めるとは知りませんでした…。

え、10年以上も誰からも指摘されたなかったってことは、
10年以上も誰か他の人が処理してくれてたってこと?

うわぁぁぁぁぁーーーーーー!
これは大変申し訳ない!
もう2度と忘れません!

と、心に誓ったんですが、
私の心に誓ったところでまぁ忘れるでしょう。
年間100件くらいは納品するので、
1件くらいは忘れてしまうかも知れません。
気合を入れても、チェックリストを作っても、
人力ではスルーすることもあるでしょう。
なので、仕組みで解決したいと思いました。

前置きが長くなりましたが、要するに

特定のメールを送信するときに、必ず特定のアドレスが含まれているかを
送信前にチェックする方法

です。

私はメールは Gmail を使っているんですが、
Gmail の GAS でそのような動きをする方法を見つけられなかった…。
迷った挙げ句、仕方ないのでメーラーを Outlook にしました。
Outlook には『Application_ItemSend イベント』というのがあって、
メーラーの送信ボタンをクリックした瞬間にこのイベントが発生します。
GAS で『Application_ItemSend イベント』に相当するものが
見つけられなかったんです…。
なので、Outlook でいろいろ書くことにしました。

私は日曜プログラマ的な感じなのでそんなに詳しくありません。
誰かのお役に立てれば幸いです。
普通の人はコードを書くとき変数に日本語は使わないんですが、
私は RPG とかで名前を決めるだけで30分とか悩むタイプなので、
絶対に被らない日本語を使ってしまっています。
(歳をとったのか、最近はデフォルト名ばっかりですけどね…。
というか、ボイスのせいで名前を決める場面が少ないですね)

特定のアドレスなどは変更してありますが、
実際に動いて使用しているものをそのまま貼ってあります。

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim 有無 As Boolean
Dim カウント As Long
Dim アドレス As String

    If InStr(Left(Item.Body, 1000), "添付") > 0 And Item.Attachments.Count = 0 Then
        If MsgBox("『添付』という文字列がありますが、添付ファイルがありません。" & vbCrLf & _
            "送信しますか?", vbInformation + vbYesNo + vbDefaultButton2, "添付ファイル") = vbNo Then
            Cancel = True
            Exit Sub
        End If
    End If

    アドレス = ""
    For カウント = 1 To Item.Recipients.Count  
        アドレス = アドレス & "," & Item.Recipients.Item(カウント).Address
    Next

    If InStr(Left(Item.Body, 1000), "※これは納品メールです。") > 0 And _
        InStr(アドレス, "1@xxxx.com") = 0 Then
        If MsgBox("納品メールのようですが、" & vbCrLf & _
            "宛先に『1@xxxx.com』がありません。" & vbCrLf & _
            "送信しますか?", vbInformation + vbYesNo + vbDefaultButton2, "納品メール") = vbNo Then
            Cancel = True
            Exit Sub
        End If
    End If

    有無 = False
    If InStr(Item.Subject, "【検収】") > 0 Then
        If InStr(アドレス, "2@xxxx.com") = 0 Then 有無 = True
        If InStr(アドレス, "3@xxxx.com") = 0 Then 有無 = True
        If 有無 = True Then
            If MsgBox("請求書添付メールのようですが、" & vbCrLf & _
                "宛先に検収メール用のアドレスがありません。" & vbCrLf & _
                "送信しますか?", vbInformation + vbYesNo + vbDefaultButton2, "検収メール") = vbNo Then
                Cancel = True
                Exit Sub
            End If
        End If
    End If

End Sub

構成としては、大きく3つです。

  1. 本文の先頭から1000文字目までに『添付』という文字があるのに、
    メールに何も添付されていない場合はアラートを出す
  2. 『※これは納品メールです。』という文字があるメールの場合、
    『1@xxxx.com』というアドレスがあるかをチェックし、
    ない場合はアラートを出す
    (実際には『※これは納品メールです。』ではない文字ですが)
  3. 件名に『【検収】』という文字があるメールの場合、
    『2@xxxx.com』『3@xxxx.com』というアドレスがあるかをチェックし、
    ない場合はアラートを出す

1は定番です。
1000文字にしたのは、
ずっと返信返信で続く形式でやり取りしているので、
ずっと下の方だったら別にいいかな、ということで。
メールを何件かみて、1000文字くらいかなと思ったのでそうしました。

2と3は似たような内容です。

一番困ったのが、メールアドレスの取得方法でした。
『VBA Outlook メールアドレス 取得』とかで検索すると
よく出てくるのが、

.To
.Cc
.Bcc

とかなんですが、
これだと Outlook の表示名の方を取得しちゃって、
ちゃんとしたアドレスが取得できないことが多いです。
@よりも前のアカウント部分しか含まれていないとか。

それが、

Item.Recipients.Item(カウント).Address

であれば、アドレスがちゃんと取得できます。

それぞれ必要なアドレスを追加しようかと思ったんですが、
なんか誤操作が怖かったので手動で追加する運用にしてあります。

これで、特定のメールのときに特定のアドレスが含まれているか
チェックできるようになりました。

…ただ、久しぶりに使った Outlook がものすごく使いにくくて…。
スレッド表示にしてても自分の送ったメールって表示されないんですか?
メールの読み込みってこんなに時間かかるんですか?
困ったなぁ…。

ということで、別の方法を考えて、
現在はそっちで試運転中です。
それはまた別の機会に。

さちこ

40代2児の母。2011年からフリーランスやってます。東京の東の方在住。
第一子が発達グレー男児で、彼が将来彼の妹に迷惑かけずに生きていけるよう、日々奮闘中です。

さちこをフォローする
パソコン関連
さちこをフォローする
hibikaizen

コメント

タイトルとURLをコピーしました