宛先に応じて署名をクイックパーツから挿入するマクロ


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


お世話になっております。
業務上 outlookを多用しており 作業の効率化を図るため
活用させていただいております。

さて過去にも “署名” について、いくつかご投稿されておりますが
署名を何パターンか登録し 送信先によって、差し込む署名を変えたいと考えております。
過去のサンプルを基に 構文を探しましたがわかりませんでした。
お手数ですが ご教授の程 宜しくお願いいたします。
また クイックパーツで登録した文章も 差し込む構文も合わせてご教授いただければ幸いです。

‘ 署名の置き換え
Set objWord = ActiveInspector.WordEditor
Set objSignature = objWord.Bookmarks(“_MailAutoSig”)
objSignature.Range.Text = ANOTHER_SIGNATURE

バージョン:OutLook2010 SP2


宛先により差し込む署名を変えるとなると、宛先と署名を紐づけるものが必要となります。
今回のマクロでは、宛先のアドレスに該当する連絡先を検索し、見つかった連絡先の分類項目の文字列を名前とするクイックパーツで署名を置き換えるというものにしてみました。
マクロは以下の通りです。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub ChangeSignatureByRecipients()
    Dim objRecip As Recipient
    Dim objContact As ContactItem
    '
    For Each objRecip In ActiveInspector.CurrentItem.Recipients
        ' 受信者のアドレスに該当する連絡先を検索
        Set objContact = FindContactByAddress(objRecip.Address)
        If Not objContact Is Nothing Then
            ' 連絡先の分類項目が設定されているか確認
            If objContact.Categories <> "" Then
                ' 分類項目の文字列を名前とするクイックパーツの埋め込み
                If ReplaceSignatureByQuickParts(objContact.Categories) Then
                    Exit For
                End If
            End If
        End If
    Next
End Sub
'   アドレスから連絡先を検索する関数
Private Function FindContactByAddress(strAddress As String)
     Dim objContacts 'As Folder
     Dim objContact As ContactItem
     '
     Set objContacts = Session.GetDefaultFolder(olFolderContacts)
     Set objContact = objContacts.Items.Find("[Email1Address] = '" & strAddress _
         & "' or [Email2Address] = '" & strAddress _
         & "' or [Email3Address] = '" & strAddress & "'")
     Set FindContactByAddress = objContact
End Function
'   指定した名前のクイックパーツで署名を置き換える関数
Private Function ReplaceSignatureByQuickParts(strName As String)
    On Error Resume Next
    Dim oDoc As Object
    Dim oWord As Object
    Dim strTemp As String
    Dim oParts As Object
    Dim oSignature As Object
    ReplaceSignatureByQuickParts = False
    ' 現在表示しているメールの Word コンポーネントを取得
    Set oDoc = ActiveInspector.WordEditor
    Set oWord = oDoc.Parent
    ' メールの標準テンプレートからクイックパーツを取得
    strTemp = oWord.Options.DefaultFilePath(2) & "\NormalEmail.dotm"
    Set oParts = oWord.templates(strTemp).BuildingBlockEntries(strName)
    ' クイックパーツが見つからなければ中断
    If oParts Is Nothing Then Exit Function
    ' メールの署名をクイックパーツで置き換え
    Set oSignature = oDoc.Bookmarks("_MailAutoSig")
    oParts.Insert Where:=oSignature.Range, RichText:=True
    ReplaceSignatureByQuickParts = True
End Function

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

広告

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中