コメントにて以下のようなご要望をいただきました。
今年から勤務先で社外宛メール送信には以下のようなルールが作られました。
To:自分のアドレス
CC:ブランク
BCC:送信したいアドレス全て
社外から来たメールを「全員に返信」した場合など、
手動でToからBCCに移さなければいけません。
ルール通りになっていないと送信エラーで戻ってくるような仕組みになっており、
慣れかもしれませんが、再送の手間が非常にタイムロスになっています。
To/CC/BCCに1つでも社外ドメインが含まれていたら
Toに自分のアドレス、その他にTo/CC/BCCに含まれていた
全ての宛先をBCCに入力(移動)して送信する、というマクロが
もし可能であれば是非教えていただけると助かります。
下記のようなマクロで実現可能です。
MY_DOMAIN と MY_ADDRESS の定義を適切に変更して使用してください。
' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Const MY_DOMAIN = "*@example.com" ' 自組織のドメイン名を指定。@ の前に * を付ける
Const MY_ADDRESS = "test@example.com" ' 自分のメールアドレス
Dim objRec As Recipient
Dim bOut As Boolean
' 組織外の受信者が存在するかどうかの確認
bOut = False
For Each objRec In Item.Recipients
If objRec.AddressEntry.Type <> "EX" Then
If Not objRec.Address Like MY_DOMAIN Then
bOut = True
Exit For
End If
End If
Next
' 組織外の受信者が含まれていた場合の処理
If bOut Then
For Each objRec In Item.Recipients
' 全受信者を BCC に移動
objRec.Type = olBCC
Next
' 自分を To に指定
Set objRec = Item.Recipients.Add(MY_ADDRESS)
objRec.Type = olTo
objRec.Resolve
End If
End Sub
こんにちは。参考になるコードをありがとうございます。
MY_DOMAINの指定ですが、同一組織内でサブドメイン(@aa.company.co.jp. @bb.company.co.jp…..)を使っている場合があるので、比較するときに「Like “*” & MY_DOMAIN」と後方一致になるようにして、MY_DOMAIN=”company.co.jp”と@をつけずに指定するとよいと思います。
また、MY_DOMAINを定数ではなく配列変数として、Array関数でまとめて指定するようにすると、自組織と判断するアドレスを複数設定できます。
Dim My_Domain As Variant
My_Domain = Array(“company1.co.jp”, “company2.co.jp”, “jibun@home.ne.jp”)
‘ 組織外の受信者が存在するかどうかの確認
Dim myItem As Variant
Dim IntYes As Boolean
bOut = False
IntYes=False
For Each objRec In Item.Recipients
If objRec.AddressEntry.Type “EX” Then
For Each myItem In My_Domain
If objRec.Address Like “*” & myItem Then IntYes = True ‘配列MY_DOMAINの要素のどれかひとつでもヒットすればIntYesをTrueにする
Next myItem
If Not IntYes Then ‘IntYesがTrueでなければ外部アドレス
bOut = True
Exit For
End If
End If
Next
ところで、ひとつ教えてください。
Recipient.AddressEntry.Typeでは、どういう場合にどのような値が得られるのですか。
ご意見ありがとうございます。参考にさせていただきます。
なお、Recipient.AddressEntry.Type はアドレスの種類を表します。通常、インターネットメールの場合は “SMTP” となりますが、Microsoft Exchange サーバーを使用して組織内の宛先に送信した場合は “EX” となります。このチェックを行っているのは、Exchange の組織内のアドレス フォーマットにはドメインが含まれず、基本的に組織内のあて先であるため、チェックする意味がないからです。
AddressEntry.TypeでExchangeサーバのアドレスがチェックできるのですね。僕は同じことを『アドレスが「/O=」で始まる』という条件でチェックしていました。自分で考えたわけではなく、ネットで検索して見つけたものです。どちらが速いかはわかりませんが(普通のメールなら気になるほどの差は出ないと思います)、AddressEntry.Typeでチェックするほうがスマートですね。
ところで、お示しいただいたマクロでは、アドレスに個人配布リストが含まれているとどうなりますか。個人配布リストは.addressが空白となっているようなので、おそらく””という外部アドレスと判断されて、誤動作するのではないかと思います。個人配布リストは.DisplayType=5という条件でチェックできるのですが、そのあとアドレス帳からその配布リストのメンバーを引っ張ってきてチェックする必要があって、面倒です。アドレスチェックをする前にすべての個人配布リストを展開(手動なら+ボタンを押す)してから行えばよいと思い、Outlookマクロで個人配布リストを展開することができないか調べてみたのですが、わかりません。もしご存知ならお教え下さい。
Outllokにもマクロ記録機能があると楽なのですが。
このマクロでは個人用配布リストを考慮してませんでした。
個人用配布リストの展開処理をマクロで実行することはできないので、マクロ内でのチェックの際にメンバーを連絡先から取得するしかありません。
投稿すると半角スペースがすべて削除されてしまうのですね。IFやForのインデントが全部飛んでしまったので、大変見にくくて申し訳ありません。
#1の
If objRec.AddressEntry.Type “EX” Then
は
If objRec.AddressEntry.Type “EX” Then
の間違いです。済みません。
Typeと”EX”の間に不等式<>の半角があるのですが、投稿すると消えてしまうようです。
[…] 返信メール作成時に組織外のアドレスを Bcc に移動するには、返信処理自体を行うマクロを作るのが簡単なものとなります。組織外への送信の際にアドレスをすべて Bcc に移動するマクロでは社外あての送信の際に自分以外のすべてのアドレスを Bcc に移動するという条件だったため、ループが二つありましたが、単に組織外のアドレスを Bcc に移動するだけならループは一つになります。マクロは以下の通りです。 […]
はじめまして。ご教示下さい。
組織外(指定したドメイン以外)のアドレスがBCC以外に含まれる場合送信を取りやめるマクロが解らず困っています。「複数のドメインが宛先に含まれています。BCCに設定し直して下さい。」というポップアップが出るようなマクロが有れば教えて下さい。BCCに設定されている場合は警告は不要です。宜しくお願い致します。
[…] 組織外への送信の際にアドレスをすべて Bcc に移動するマクロのコメントにて以下のご要望をいただきました。 […]