Outlook 2003 でメッセージの受信者の部署名により送信チェックを行なうマクロ


以前、メッセージの受信者の Exchange のプロパティを取得するマクロという記事で、Outlook 2007 用の受信者の部署名チェックを行なうマクロを紹介しました。しかし、ご要望をいただいた方は Outlook 2003 をお使いということであったため、今回は Outlook 2003 でも使えるマクロを紹介します。

まず、Outlook 2003 においては GetExchangeUser というメソッドが使用できないため、グローバル アドレス一覧の部署名などの情報を取得するには CDO 1.21 を使用する必要があります。しかし、この方法を用いた場合、アドレス帳へのアクセスの際に警告ダイアログが毎回表示されてしまい、これを防ぐにはパブリック フォルダ上に Security Settings のフォームを発行するなど、Exchange 管理者の手を借りる必要があります。

そこで、グローバル アドレス一覧のうち、同じ部署に所属するユーザーだけを Outlook の連絡先にコピーし、連絡先から部書名の取得を行なうようなマクロにしました。このマクロを使用するには、事前にグローバル アドレス一覧で同じ部署に所属するユーザーを右クリックし、[連絡先フォルダに追加] で Outlook の連絡先に追加してください。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Const MY_DEPARTMENT = "IT Department" ' 自分の部署名を指定します。
    Dim objRecip As Recipient
    Dim objContact As ContactItem
    Dim strExternal As String
'
    If Item.MessageClass Like "IPM.TaskRequest*" Then
        Set Item = Item.GetAssociatedTask(False)
    End If
'
    strExternal = ""
    For Each objRecip In Item.Recipients
        Set objContact = FindContactByAddress(objRecip.Address)
        If objContact Is Nothing Then
            strExternal = strExternal & objRecip.Name & ";"
        Else
            If objContact.Department <> MY_DEPARTMENT Then
                strExternal = strExternal & objRecip.Name & ";"
            End If
        End If
    Next
'
    If strExternal <> "" Then
        If MsgBox("あて先に他部署の受信者が含まれています。送信してよろしいですか?" & vbLf & _
        "受信者名:" & strExternal, vbYesNo, "受信者の確認") = vbNo Then
            Cancel = True
        End If
    End If
End Sub
'
Private Function FindContactByAddress(strAddress As String)
    Dim objContacts
    Dim objContact
    Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts)
    Set objContact = objContacts.Items.Find("[Email1Address] = '" & strAddress _
        & "' or [Email2Address] = '" & strAddress _
        & "' or [Email3Address] = '" & strAddress & "'")
    Set FindContactByAddress = objContact
End Function

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

広告

Outlook 2003 でメッセージの受信者の部署名により送信チェックを行なうマクロ」への1件のフィードバック

  1. いつもいつも大変ありがとうございます。助かりました。これで誤送信も低減すると思います。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中