複数の連絡先フォルダーから連絡先を検索し、メールの先頭に受信者の名前を追加するマクロ


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


あて先に指定したアドレスの名前を本文に追加するマクロを使用させて頂いてます。
大変便利な機能で、活用させて頂いております。

現在、複数の連絡先フォルダを使っておりますが、AddHeaderでは対応していない思います。
対応して頂けると助かります。

連絡先(会社)にあるアドレスからの返信時には
事業所名
名前 + 敬称
連絡先(顧客)にあるアドレスからの返信時には
会社名
名前 + 役職

というようになればさらに便利になると思います。

よろしくお願いします。


既定の連絡先フォルダーの直下に複数のフォルダーがあると想定した場合のマクロは以下のようになります。AddHeader2 を実行してください。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub AddHeader2()
    Dim objMail As MailItem
    Dim objContact As ContactItem
    Dim objContacts As Folder
    Dim i As Integer
'
    Set objMail = Application.ActiveInspector.CurrentItem
    Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts)
    For i = objMail.Recipients.Count To 1 Step -1
        With objMail.Recipients.Item(i)
            If .Type = olTo Then
                Set objContact = FindContactByAddressInAFolder(.Address, objContacts)
                If Not objContact Is Nothing Then
                    objMail.Body = objContact.LastFirstAndSuffix & vbCrLf & objMail.Body
                Else
                    Set objContact = FindContactByAddressInAFolder(.Address, objContacts.Folders("連絡先(会社)"))
                    If Not objContact Is Nothing Then
                        objMail.Body = objContact.Department & vbCrLf & "  " & objContact.LastFirstSpaceOnly & " " & objContact.JobTitle & vbCrLf & objMail.Body
                    Else
                        Set objContact = FindContactByAddressInAFolder(.Address, objContacts.Folders("連絡先(顧客)"))
                        If Not objContact Is Nothing Then
                            objMail.Body = objContact.CompanyName & vbCrLf & "  " & objContact.LastFirstAndSuffix & vbCrLf & objMail.Body
                        End If
                    End If
                End If
            End If
        End With
    Next
End Sub
'
Private Function FindContactByAddressInAFolder(strAddress As String, objContacts)
    Dim objContact As ContactItem
    '
    Set objContact = objContacts.Items.Find("[Email1Address] = '" & strAddress _
        & "' or [Email2Address] = '" & strAddress _
        & "' or [Email3Address] = '" & strAddress & "'")
    Set FindContactByAddressInAFolder = objContact
End Function

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

広告

複数の連絡先フォルダーから連絡先を検索し、メールの先頭に受信者の名前を追加するマクロ」への4件のフィードバック

  1. 早速の対応、有り難うございます。
    マクロで連絡先ごとに記載されるフィールドを変えて使ってみます。

  2. 上記のマクロ重宝させていただいております。細かいことですが、メール本文に鵜入される文字のフォントとフォントサイズが送信メールの既定のフォントと異なるフォントとフォントサイズで挿入されてしまいます。既定のフォントで挿入するか文字のフォントとフォントサイズを指定して挿入する方法はありますでしょうか。もちろん相手に送信するメールにはフォントやフォントサイズの情報は無く受信側には何も影響が無いことは承知の上でご質問します。

  3. 先ほどのメールのフォントとフォントサイズの件ですが、インデントの値も既定の値から変ってしまい、かつ受信側のメール送受信ソフトの表示も変ってしまうことがわかりました。是非とも既定の設定を変えずに文字を挿入する方法を教えていただきたく思います。

  4. […] マクロAddHeader2を重宝させていただいております。細かいことですが、メール本文に鵜入される文字のフォントとフォントサイズをはじめインデントの設定などが送信メールの既定の設定と異なる設定で挿入されてしまいます。既定の設定で文字を挿入する方法はありますでしょうか。フォントやフォントサイズについては、受信側には何も影響がありませんが,インデントの値については受信側のメール送受信ソフトの表示も変ってしまうことがわかりました。是非とも既定の設定を変えずに文字を挿入する方法を教えていただきたく思います。 […]

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中