Ccの社外アドレスを削除するマクロ


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


Toのアドレスが社内の場合、CCに社外アドレスが入っていたら自動的に社外アドレスを削除(社外アドレスがBCCに入っている場合はそのまま送信)するようにしたいのですが、そういった処理を行うマクロを書いていただけないでしょうか?

「CCに社外アドレスが入っていたので削除して、社内アドレスのみに送信しました」といったメッセージが表示できればなお嬉しいです。



「Toのアドレスが社内の場合」とありますが、To アドレスには複数指定できるので、To が社内と社外の混在というパターンも考えられます。
今回のご要望が誤送信防止や個人情報保護の一環ということであれば、おそらく To に社内アドレスのみが存在する場合に処理が必要と思われたので、以下のようなマクロにしてみました。
もし、To に社外アドレスがあっても削除が必要ということであれば、「And bExt(olTo) = False」を削除してください。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Const INTERNAL_DOMAIN = "*@example.com" ' 社内ドメイン指定、* が先頭に必要
    Dim bInt(3) As Boolean
    Dim bExt(3) As Boolean
    Dim i As Integer
    For i = 0 To 3
        bInt(i) = False
        bExt(i) = False
    Next
    With Item.Recipients
        For i = .Count To 1 Step -1
            If .Item(i).Address Like INTERNAL_DOMAIN Then
                bInt(.Item(i).Type) = True
            Else
                bExt(.Item(i).Type) = True
            End If
        Next
        ' To に社内アドレスのみ、Cc に社外アドレス
        If bInt(olTo) = True And bExt(olTo) = False And bExt(olCC) = True Then
        ' To に社内アドレス、To と Cc に社外アドレスの場合は下記の条件を使用
        ' If bInt(olTo) = True And bExt(olCC) = True Then
            For i = .Count To 1 Step -1
                If Not .Item(i).Address Like INTERNAL_DOMAIN And _
                       .Item(i).Type <> olBCC Then
                    ' BCC 以外の社外アドレスを削除
                    .Item(i).Delete
                End If
            Next
            MsgBox "CC に社外アドレスが入っていたので削除して、" & _
                "社内アドレスのみに送信しました。"
        End If
    End With
End Sub

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

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中