送信アカウントにより送信先アドレス種別をチェックして警告を表示するマクロ


コメントで以下のようなご要望をいただきました。


現在、社内用のアカウントと社外用のアカウントがあり、
社内用のアカウントを使って、社外の方へメ-ルを送ってしまい
届いていない、また逆の事例もある状況です。
そこで、お聞きしたいのですが、社内用の連絡先のフォルダ(パブリックフォルダ内)を検索して、
上記の様にクロスしてしまう場合は、警告文を出せるマクロは作成可能でしょうか?
よろしくお願いします。



パブリック フォルダーがあるということは Exchange 環境と思われるのですが、この場合は以下のような処理をするマクロということになります。

  • Exchange のアカウントで Exchange 以外の受信者に送信する場合に警告を行う
  • Exchange 以外のアカウントで Exchange の受信者に送信する場合に警告を行う

この場合、パブリック フォルダーを参照しなくても、単にアドレス種別だけで Exchange 組織内かどうかの判断が可能です。

マクロは以下のようなものになります。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim strValid As String
    Dim recOne As Recipient
    Dim bCross As Boolean
    ' 送信アカウントが Exchange なら EX アドレスへ送信可能
    If Item.SendUsingAccount.AccountType = olExchange Then
        strValid = "EX"
    Else
    ' 送信アカウントが Exchange でなければ SMTP アドレスへ送信可能
        strValid = "SMPT"
    End If
    ' 宛先のアドレス種別をチェック
    bCross = False
    For Each recOne In Item.Recipients
        If recOne.AddressEntry.Type <> strValid Then
            bCross = True
            Exit For
        End If
    Next
    ' 送信可能なアドレス種別でなければ警告
    If bCross Then
        If MsgBox("送信アカウントで送信すべきでない宛先が含まれています。送信しますか?", vbYesNo) = vbNo Then
            Cancel = True
        End If
    End If
End Sub

マクロの登録方法やメニューへの追加について

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中