メールアドレスのリンクをクリックした際に宛先の表示名を自動的に連絡先のものに置き換えるマクロ


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


社内サイト内からメールアドレスリンクをクリックし新規メールを作成する際、表示名をアドレス帳の表示名に置き換えるマクロはありますか?

せっかくアドレス帳に入っているのに表示名がメールアドレスなので統一したいです。

よろしくお願い致します。


宛先の表示名を連絡先の表示名で置き換えるマクロは「返信メッセージで表示名をアドレス帳のものに置き換えるマクロ」や「送信済みアイテム フォルダの宛先を連絡先に表示名に置き換えるマクロ」として公開していますが、これらは返信時などに手動でマクロを実行する必要があります。
メールアドレスの リンク (mailto) をクリックした際に自動的に表示名の置き換えをするには、新規のメッセージ作成ウィンドウ (Inspector) が開かれた際に発生する NewInspector イベントを使用します。
このイベントは Inspectors というオブジェクトのものですが、このオブジェクトのイベントを処理するためには、あらかじめ Inspectors のイベントを処理するための変数を WithEvents というキーワード付きで定義しておき、Outlook の起動時に発生する Application_Startup イベントでその変数に Application.Inspectors を設定する必要があります。

マクロは以下のようになります。

' ここをトリプルクリックでマクロ全体を選択できます。

' NewINspector イベントを受けるオブジェクト
Dim WithEvents myInspectors As Inspectors
' 起動時に実行されるイベント
Private Sub Application_Startup()
     Set myInspectors = Application.Inspectors
End Sub
' 新規のメッセージ作成ウィンドウ (Inspector) が開くときのイベント
Private Sub myInspectors_NewInspector(ByVal Inspector As Inspector)
     Dim objMail 'As MailItem
     Set objMail = Inspector.CurrentItem
     ' 送信前のメール アイテムを開いた場合だけ処理
     If objMail.MessageClass = "IPM.Note" And Not objMail.Sent Then
         ResolveAddressEx objMail
     End If
End Sub
' アドレス帳で名前解決を行うマクロ
Public Sub ResolveAddressEx(ByVal objMail As MailItem)
     Const PR_SMTP_ADDRESS = "http:" & "//schemas.microsoft.com/mapi/proptag/0x39FE001E"
     Dim objRecip As Recipient
     Dim objContact As ContactItem
     Dim objAddrList As AddressList
     Dim i As Integer
     Dim objAddrEntry As AddressEntry
     Dim cRecips As Integer
     Dim colAddress() As String
     Dim colName() As String
     Dim colType() As Integer
     Dim strEntryID As String
     '
     With objMail.Recipients
         ' あらかじめ名前解決を実行
         .ResolveAll
         cRecips = .Count
         ReDim colAddress(cRecips) As String
         ReDim colName(cRecips) As String
         ReDim colType(cRecips) As Integer
         For i = cRecips To 1 Step -1
             ' 受信者オブジェクトを取得
             Set objRecip = .Item(i)
             ' 受信者の情報を配列にコピー
             With objRecip.AddressEntry
                 If .Type = "SMTP" Then
                     colAddress(i) = objRecip.Address
                 Else
                     colAddress(i) = .PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
                 End If
             End With
             colName(i) = objRecip.Name
             colType(i) = objRecip.Type
             ' コピーした受信者を削除
             .Remove i
         Next
         '
         For i = 1 To cRecips
             Set objRecip = Nothing
             ' アドレス帳から受信者のアドレスを検索
             For Each objAddrList In Session.AddressLists
                 ' Outlook アドレス帳だけが検索対象
                 If objAddrList.AddressListType = olOutlookAddressList Then
                     For Each objAddrEntry In objAddrList.AddressEntries
                         ' アドレスが一致したらアドレス帳の情報を受信者に設定
                         If objAddrEntry.Address = colAddress(i) Then
                             Set objRecip = .Add(colAddress(i))
                             Set objRecip.AddressEntry = objAddrEntry
                             objRecip.Type = colType(i)
                             objRecip.Resolve
                             Exit For
                         End If
                     Next
                     ' 受信者が見つかったら For ループを脱出
                     If Not objRecip Is Nothing Then
                         Exit For
                     End If
                 End If
             Next
             ' 受信者が見つからなければ元の情報で追加
             If objRecip Is Nothing Then
                 If colName(i) <> colAddress(i) Then
                     Set objRecip = .Add(colName(i) & "<" & colAddress(i) & ">")
                 Else
                     Set objRecip = .Add(colAddress(i))
                 End If
                 objRecip.Type = colType(i)
             End If
         Next
         ' 名前解決の再実行
         .ResolveAll
     End With
End Sub

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

広告

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中