2017年7月
            1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31          

« 2011年10月 | トップページ | 2011年12月 »

2011年11月26日 (土)

◆Outlook VBA(メール誤送信防止のためのチェックあれこれ その4)

メール誤送信防止のためのチェックについて、機能を追加してみました。
追加した機能は、送信先のアドレス(To,Cc,Bcc)に自ドメイン以外のアドレスが含まれていた場合、その旨知らせるメッセージを表示するというものです。
以下の要領で実装します。

(1)ThisOutlookSessionのソース(記事:その2)に以下の1文を追加
      ・
      ・
      ・
      lSubject = Item.Subject     '件名
      lBody = Item.Body           '本文
→   gSendname = Item.Session.CurrentUser.Address '送信者
   
      '件名チェック
      ・
      ・
      ・
(2)標準モジュールのソース(記事:その3)に以下の1文を追加
  Public gTitle As String
  Public gAddress
  Public gTempFile
  Public SendFlg As Boolean
→ Public gSendname
      ・
      ・
      ・
(3)ユーザフォームにLabel5を追加。一応警告なのでForeColorは赤にしてみました。
(4)ユーザフォームのソース(記事:その3)の宛先処理を以下に変更
      ・
      ・
      ・
    '宛先
    ldomain = Split(gSendname, "@")
   
    U1.Label3.Caption = U1.Label3.Caption & " 件数:" & gAddress.Count
    Dim lcnt As Integer
    lcnt = 0
    OutFlg = False
    For Each oAddress In gAddress
        lcnt = lcnt + 1
        If Not (oAddress.Address Like "*" & ldomain(1)) Then
            OutFlg = True
        End If
        U1.ListBox1.AddItem Format(lcnt, "00") & "." & oAddress.Name & " 【" & oAddress.Address & "】"
    Next
    If OutFlg = True Then
        U1.Label5.Caption = "自ドメイン (" & ldomain(1) & ") 以外のアドレスが含まれています。"
    Else
        U1.Label5.Caption = ""
    End If
      ・
      ・
      ・

で、実行した結果が以下のようになります。自ドメインは自分の送信者アドレスから抽出しています。
そのドメインと宛先のアドレスのドメインが異なったらメッセージを表示するというしくみです。
Domain_chk_2

« 2011年10月 | トップページ | 2011年12月 »