前回の
のドメイン判定ロジックを利用してドメイン毎に署名を切り替える処理をご紹介します。
もくじ
署名ってよく間違えませんか
今や仕事のシェアード化が進み、また請負先へ常駐していたりなど一人2、3役で様々な顔を使い分けて仕事をするケースが多いかと思います。
タカヒロもよくやってしまうのはメールの署名を社外向けとすべきが社内向けになったり間違えてしまうことです。
端末も複数のPCを利用している場合は特に発生しやすいです。
メール誤送信には該当しないので、まあいいか、で済ましていますが、、受け手に対してはあまりよろしくありません。
そこで社内ドメインを定義しそれに該当する場合は社内の署名、該当しない場合は社外の署名に切り替えられるようなVBAを作ってみたいと思います。
マクロを設置する下準備をする。
以下を参考にVBAコードを配置する場所を表示させます。
マクロを登録する
「開発」タブ>「Visual Basic」を押します。
「Visual Basic Editor」にて、[Project1] > [Microsoft Outlook Objects] > [ThisOutlookSession] を開きます。
右のコードエリアへ、以下のコードを貼り付けて保存します。
Public Sub 署名変更()
'社内用と社外用の署名を定義
Const signature1 = "(社内)〇〇部 えくた たろう(#内線)"
Const signature2 = "------------" & vbCrLf & "(社外)〇〇〇株式会社 〇〇部〇〇課" & vbCrLf & "えくた たろう(#代表番号)"
Dim myDomainList As Variant
Dim checkNum As Long
Dim Item As Object
Dim recips As Object
Dim pa As Object
Dim senderDomainList As Variant
Dim bookmark As Object
Dim signature As Object
'チェックナンバー初期化
checkNum = 0
'指定ドメイン(社内ドメインとして定義します。該当しない場合は社外とします。)
myDomainList = Array("extan.jp", "extan2.jp")
'outlookオブジェクトの名前空間を指定
Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
Set Item = ActiveInspector.CurrentItem
Set recips = Item.Recipients
'宛先のSMTPアドレスを取得
Set pa = recips(1).PropertyAccessor
'ドメインだけにする
senderDomainList = Split(pa.GetProperty(PR_SMTP_ADDRESS), "@")
'社内ドメインと宛先のドメインが一致しているかチェック 一致した場合は1を代入。
For i = 0 To UBound(myDomainList)
If myDomainList(i) = senderDomainList(1) Then
checkNum = 1
End If
Next
'本文のオブジェクトを取得
Set bookmark = ActiveInspector.WordEditor
'署名のオブジェクトを取得
Set signature = bookmark.Bookmarks("_MailAutoSig")
'署名の置き換え
If checkNum = 1 Then
signature.Range.Text = signature1
Else
signature.Range.Text = signature2
End If
'オブジェクトの開放
Set Item = Nothing
Set bookmark = Nothing
Set signature = Nothing
End Sub
試しに署名が切り替えられる確認をする
コードの説明はさておき、早速チェックされるか確認をしてみましょう。
新規にメールを作ります。
ホワイトリストに社内ドメイン”extan.jp”, “extan2.jp”を指定していますので、宛先にそのドメインが含まれるアドレスを挿入します。
なお、署名はデフォルトで入るようにしてください。デフォルトの署名がない場合は署名を入れる場所が取得できずエラートなるからです。
次に「開発」タブ>「マクロ」から「署名変更」ボタンを押します。
はい!署名が社内向けに変更されましたね。
社外の場合も確認したいので社内ドメイン以外のアドレスを指定して、マクロ実行。
はい!署名が社外向けに変更されましたね。
さいごに
いかがでしょうか。マクロから選択することが面倒である場合はマクロボタンをメニューに追加したり、送信ボタン押下時に自動実行されるようにしてもいいかもしれませんね。
次回もいろいろな使い方をとりあげていきたいと思います!
署名変更のコードの情報提供ありがとうございます。
私のOutlookでは★の行で以下のエラーが表示されて機能しませんでした。
何か原因ありますでしょうか?
(申し訳ありませんが、当方ExcelVBAは初級レベル、OutlookVBAは全くのド素人です。簡単な解説をいただけると助かります。よろしくお願いいたします。)
実行時エラー’91
オブジェクト変数またはWithブロック変数が設定されていません。
‘outlookオブジェクトの名前空間を指定
Const PR_SMTP_ADDRESS As String = “http://schemas.microsoft.com/mapi/proptag/0x39FE001E”
Set Item = ActiveInspector.CurrentItem ★
Set recips = Item.Recipients
なお、ページに記載されたコードは、以下1か所以外基本的に変えていません。
‘チェックナンバー初期化
checNum = 0 → checkNum = 0 定義に合わせた誤記修正
いつもご利用ありがとうございます。
実行時のエラー91につきまして、
新規/返信メールが別ウインドウで表示されているか確認頂けますでしょうか。
ActiveInspector.CurrentItemは今開いている子ウインドウのアイテムが対象となりますので、
子ウインドウがない場合(Outlook本体のみである状態)は取得できずエラーとなります。
また変数名ミスの件は申し訳ありません。
記事のコードを修正させて頂きました。
よろしくお願いいたします。