返信時や転送時のヘッダーをシンプルにするマクロ


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


マクロの要望です。
「返信や転送時の引用文前に挿入されるヘッダー情報を変更したい。」

検索すると同様の質問はあるのですが解決策は見つかりませんでした。
私は諸事情でThunderbirdから乗り換えたのですが、どうもこの分厚いヘッダー部が嫌なのです。
そこで、Thunderbirdライクに

「(yyyy/mm/dd hh:mm), %name% wrote:」

と書き換えるか、もしくは一部だけ削って

「—–Original Message—–
From: %name% [mailto:hoge@fugafuga.com] 」

の様にするマクロは可能でしょうか。


下記のようなマクロで実現可能です。
返信・転送したいメッセージをダブルクリックで開き、ReplyAllSimple マクロを実行すると全員に返信、ForwardSimple マクロを実行すると転送ができます。

' ここをトリプルクリックでマクロ全体を選択できます。
' 全員に返信
Public Sub ReplyAllSimple()
    Dim objMail As MailItem
    With ActiveInspector.CurrentItem
        Set objMail = .ReplyAll
        ReplaceHeader objMail, .SenderName, .SentOn, "Reply"
        objMail.Display
    End With
End Sub
' 転送
Public Sub ForwardSimple()
    Dim objMail As MailItem
    With ActiveInspector.CurrentItem
        Set objMail = .Forward
        ReplaceHeader objMail, .SenderName, .SentOn, "Forward"
        objMail.Display
    End With
End Sub
' ヘッダ置き換え
Private Sub ReplaceHeader(objMail As MailItem, strSender As String, dtSentOn As Date, strMode As String)
    On Error Resume Next
    Dim objReply As MailItem
    Dim strBody As String
    Dim s As Integer
    Dim e As Integer
    '
    If objMail.BodyFormat = olFormatHTML Then
        strBody = objMail.HTMLBody
        s = InStr(strBody, "<a name=""_MailOriginal"">")
        e = InStr(s, strBody, "</p>")
        strBody = Left(strBody, s - 1) & "<b>(" & dtSentOn & "), " & strSender & " </b> wrote:" & Mid(strBody, e)
        'strBody = Left(strBody, s - 1) & "<b>From: </b>" & strSender & Mid(strBody, e)
        objMail.HTMLBody = strBody
    Else
        Dim strPrefix As String
        strPrefix = ""
        strBody = objMail.Body
        s = InStr(strBody, "-----Original Message-----")
        If Mid(strBody, s - 1, 1) <> vbLf Then
            strPrefix = GetPrefixText(strMode)
        End If
        e = InStr(s, strBody, vbCrLf & strPrefix & vbCrLf)
        strBody = Left(strBody, s - 1) & "(" & dtSentOn & "), " & strSender & " wrote:" & Mid(strBody, e)
        'strBody = Left(strBody, s - 1) & "-----Original Message-----" & vbCrLf & "From: " & strSender & Mid(strBody, e)
        objMail.Body = strBody
    End If
End Sub
'
Function GetPrefixText(strMode As String) As String
    On Error Resume Next
    Dim wshShell As Variant
    Dim iStyle As Integer
    Dim strPrefix As String
    strPrefix = ""
    Set wshShell = CreateObject("WScript.Shell")
    iStyle = wshShell.RegRead("HKCU\Software\Microsoft\Office\" & Left(Application.Version, 2) & _
        ".0\Outlook\Preferences\" & strMode & "Style")
    If iStyle = 1000 Then
        strPrefix = wshShell.RegRead("HKCU\Software\Microsoft\Office\" & Left(Application.Version, 2) & _
            ".0\Outlook\Preferences\PrefixText")
        If strPrefix = "" Then
            strPrefix = "> "
        End If
    End If
    GetPrefixText = strPrefix
End Function

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

更新履歴

2012/3/23 インデント記号をつけて返信・転送する場合に対応しました。

2014/5/2 インデント記号をつけずに返信・転送する場合の動作を修正しました。

広告

返信時や転送時のヘッダーをシンプルにするマクロ」への7件のフィードバック

  1. いつも大変このサイトにはお世話になっております。
    outlookを返信・転送する際に「返信時や転送時のヘッダーをシンプルにするマクロ」をぜひ利用させていただこうと
    マクロ設定してみたのですが、レジストリに ・・・preference/PrefixText がないため開けずエラーが発生しています。
    このエラーの回避方法をご教示いただけると幸いです。

    ・OS:WIN 7 Pro
    ・outlook Ver 2010
    ・確認したレジストリ
    HKCU\Software\Microsoft\Office\14.0\Outlook\Preferences\ →ここにPrefixText がありませんでした

    以上、どうぞよろしくお願いいたします。

    • PrefixText は [ファイル]-[オプション] の [メール] にある [テキスト形式のメッセージの行頭に次のテキストを入れる] を設定することで書き込まれます。
      あるいは、レジストリ エディターで直接書き込んでいただいても構いません。

      • こんにちは。
        最近Win7pro/Outlook2010を使い始めてこのマクロを発見、大変便利に使わせて頂いています。

        実は当初私も ふぐたふぐお さんと同じ状況でレジストリにPrefixTextエントリーがなく、しばしハマりました(笑)。
        無事解決出来ましたが。

        当初から設定の[テキスト形式のメッセージの行頭に次のテキストを入れる] にはデフォルト?で「〉」が設定してあったのですが、
        それを消したり書き直したりで設定し直すも依然、PrefixTextエントリーが存在しない状態は変わらずでした。

        結局、「返信/転送」項目の
        「メッセージに返信するとき(R)」あるいは「メッセージを転送するとき(F)」の設定を、
        「元のメッセージの行頭にインデント記号を挿入する」にしてやるとレジストリにPrefixTextが出現、本件解決しました。
        一度でもここの設定をすれば、以後は関連の設定をどう弄ってもPrefixTextエントリーは消えないようです。

        Outlook2010の潜在バグ?なのかはよく判りませんが。。。
        以上、ご参考までに。

      • 既定では PrefixText レジストリが存在しないことを失念しておりました。
        PrefixText がない場合でも動作するよう修正しました。

  2. お世話になります。
    上記のマクロ、大変便利でありがたいのですが、
    メッセージルールを活用して、自動転送するさい、自動的に実行するようにはできないものでしょうか。

  3. 質問です。
    このマクロを、Inspector.CurrentItem(メッセージ作成時)で毎回適用するマクロは可能でしょうか?

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中