任意のアカウントで返信し、宛先の表示名をアドレス帳のものに置き換えるマクロ


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


outlook2007を使用しております。
以前、”任意のアカウントで返信するマクロ”と”返信メッセージで表示名をアドレス帳のものに置き換えるマクロ”を公開されて
おりましたが、これを合体させたマクロは、ありますでしょうか。
任意のアカウントで返信メッセージの表示名をアドレス帳のものに置き換えたいのですが、
御検討をお願いできませんでしょうか。


2つのマクロをマージすると以下のようになります。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub ReplyByAlterAccountWithABName()
    Const REPLY_ACCOUNT = "replyserver"
    Dim objReply As MailItem
    Dim objRecip As Recipient
    Dim objContact As ContactItem
    Dim objAddrList As AddressList
    Dim i As Integer
    Dim objAddrEntry As AddressEntry
    Dim bFound As Boolean
    Dim cRecips As Integer
    Dim colAddress() As String
    Dim colName() As String
    Dim colType() As Integer
    Dim objInsp As Inspector
    Dim cbStd As CommandBar
    Dim cbpAccts As CommandBarPopup
    Dim cbbAcct As CommandBarControl
    '
    Set objReply = ActiveInspector.CurrentItem.ReplyAll
    ' メッセージ一覧で選択されたアイテムに返信する場合は、下記を使用
    ' Set objReply = ActiveExplorer.Selection(1).ReplyAll
    '
    '   アドレス帳の表示名に置き換える
    cRecips = objReply.Recipients.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 = objReply.Recipients.Item(i)
        colAddress(i) = objRecip.Address
        colName(i) = objRecip.Name
        colType(i) = objRecip.Type
        objReply.Recipients.Remove i
    Next
    '
    For i = 1 To cRecips
        Set objRecip = Nothing
        For Each objAddrList In Session.AddressLists
            If objAddrList.AddressListType = olOutlookAddressList Then ' Outlook 2003 の場合はこの行をコメントアウトし、下の1行を有効にする
            'If objAddrList.Name = "連絡先" Then
                For Each objAddrEntry In objAddrList.AddressEntries
                    If objAddrEntry.Address = colAddress(i) Then
                        Set objRecip = objReply.Recipients.Add(colAddress(i))
                        Set objRecip.AddressEntry = objAddrEntry
                        objRecip.Type = colType(i)
                        Exit For
                    End If
                Next
                If Not objRecip Is Nothing Then
                    Exit For
                End If
            End If
        Next
        If objRecip Is Nothing Then
            Set objRecip = objReply.Recipients.Add(colName(i) & "<" & colAddress(i) & ">")
            objRecip.Type = colType(i)
        End If
    Next
    objReply.Display
    DoEvents
    ' 送信アカウントの選択
    ' [標準] のツールバーを取得
    Set cbStd = ActiveInspector.CommandBars("Standard")
    ' [アカウント] のポップアップ コントロールを取得
    Set cbpAccts = cbStd.FindControl(ID:=31224)
    ' [アカウント] のリストを検索
    For Each cbbAcct In cbpAccts.Controls
        ' 返信用のアカウント名が見つかった
        If InStr(cbbAcct.Caption, REPLY_ACCOUNT) > 0 Then
            ' 見つかったアカウントを選択
            cbbAcct.Execute
        End If
    Next
End Sub

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

広告

任意のアカウントで返信し、宛先の表示名をアドレス帳のものに置き換えるマクロ」への7件のフィードバック

  1. お世話になります。

    試してみましたが、マクロを実行すると相手から送ってきた宛先名(自分)も返信宛先に
    表示されます。
    何か回避策ありませんでしょうか。

    要望ばかりで申し訳ありませんが、宜しくお願い致します。

    • 本来であれば、自分自身は全員に返信する際には宛先には含まれません。
      自分自身のアドレスは正しく設定されているのでしょうか?
      また、POP サーバーからのメールを Exchange サーバーのメールボックスに配信したりしていませんか?

      • コメントありがとうございます。

        POPサーバーからのメールをExchangeサーバーのメールボックスに配信はしていませんが、
        確認したところ、マクロ実行時、相手から送ってきた宛先名がアドレス帳に無い場合、
        そのアドレスが全て宛先名に表示されます。
        (例えば、CC:で送られてきたアドレスがアドレス帳に無い場合、そのアドレスが宛先名に表示されます。)

        これは、何か設定が悪いのでしょうか?

  2. コメントありがとうございます。

    何度も申し訳ございません。
    確認しましましたが、マクロ実行時、相手から送ってきた宛先名(To)が返信宛先に
    表示されます。
    なにが原因なのでしょうか?

    • 追記です。

      宛先が他のアドレス(自分以外)でCC:に自分のアドレスが入っている場合、
      やはり宛先に入っているアドレスが、返信宛先(TO:)に表示されます。

      何度も申し訳ございませんが、宜しくお願い致します。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中