最近やんごとなき事情でメーラがOutlook2016に変わって、返信時に引用文が自動的に折り返され、引用が繰り返されるとリンクやパスなどが引用文に入っていた場合全く役に立たなくなって困っていました。
返信時に元のメッセージの行頭にインデント記号を含めて引用すると、送信時の折り返しの設定を無視し64バイトで折り返しが行われます。
これを回避するためOutlook2007までは、AddTickMarksWithoutLineBreaks という設定がありました。
しかしOutlook2010以降は、AddTickMarksWithoutLineBreaks によって返信時の折り返しをしないという設定ができません。
※マイクロソフトコミュニティ：返信や転送の際の自動折り返しをなくす方法
※OUTLOOK研究所：返信や転送の際の自動折り返しをなくす方法
↑OUTLOOK研究所の記事にあるコメントでは「Outlook 2010 以降でも利用可能です。」と書いてあるのですが、Outlook2016で実験してみたところ AddTickMarksWithoutLineBreaks=1 としても返信時に自動折り返しされました。
そこで、Outlookの返信時に引用文の自動折り返しをしないプラグイン作成してみましたので紹介します。
※ソースコードはGitHubに公開しています。
https://github.com/hiro-753/Outlook-ReplyWithQuoting/commits/master/ReplyWithQuoting.bas
※OUTLOOK 研究所を参考にしています(詳細なURLは最後に載せました)。
※本バージョンは返信時に既定の署名が固定で挿入されます。署名が複数あって後から署名を変更できるようにしたバージョンは、「Outlook2016の返信時に引用文の自動折り返しをしないマクロ2(署名切替対応版)」に載せました。
※下記ソースコード部分は横スクロールをかけているのでPCブラウザモードでご覧ください。
Public Sub ReplyWithQuoting()
'
' 全員に返信（折り返し無し）
'
' メール一覧から返信したいメール行を選択して実行すると、
' テキスト形式の場合引用符付き折り返し無しで返信するメールを
' 作成してエディタが開きます。
'
Dim msgReply As MailItem '返信メール
Dim strBody As String '自動改行された引用符付き引用文
Dim s As Integer '引用符付き引用文の先頭の引用符の直後
Dim e As Integer 'メールヘッダの最後
Dim strMode As String '引用符モード
Dim msgCopy As MailItem '自動改行されいない元のメール
Dim docBody As Object '自動改行されていない元のメール文
Dim strSel As String '作成したい引用符付き引用文
'返信メールを作成
Set msgReply = ActiveExplorer.Selection(1).ReplyAll
'TEXT 形式を設定(強制的にテキストにする場合)
'msgReply.BodyFormat = olFormatPlain
'返信用引用符を設定
strMode = "Reply"
If msgReply.BodyFormat = olFormatHTML Then
'HTMLの場合何もしない
Else
Dim strPrefix As String
strPrefix = vbCrLf
strBody = msgReply.Body
'引用文の先頭の引用符の直後の文字位置を取得
s = InStr(strBody, "-----Original Message-----")
'通常の返信ボタンで生成した自動改行された引用文に
'引用符が使用されているかチェック
If Mid(strBody, s - 1, 1) <> vbLf Then
strPrefix = GetPrefixText(strMode)
End If
'自動改行がない引用文を作成する
Set msgCopy = ActiveExplorer.Selection(1)
'表示しているメールの WordEditor を取得
Set docBody = msgCopy.GetInspector.WordEditor
'全てを選択
docBody.Range(0, 0).Select
docBody.Application.Selection.WholeStory
'通常の返信ボタンで生成した引用文から引用符を、
'元の文の先頭に付ける
strSel = strPrefix & docBody.Application.Selection.Text
If strPrefix <> vbCrLf Then
' 選択範囲の行の頭に引用記号を追加
strSel = Replace(strSel, vbCr, vbCr & strPrefix)
' 選択範囲の最後が改行の場合は最後の引用記号を削除
If strSel Like "*" & strPrefix Then
strSel = Left(strSel, Len(strSel) - Len(strPrefix))
End If
Else
'引用符が空の場合は改行を先頭に追加
strSel = strPrefix & strSel
End If
'通常の返信ボタンで生成した自動改行された引用文から、
'引用符のみの最初の空行を見つけてメールヘッダの最後とする
e = InStr(s, strBody, strPrefix & vbCrLf)
'通常の返信ボタンで生成した自動改行された引用文を削除し、
'メールヘッダのみ取り出す
strBody = Left(strBody, e)
'メールヘッダに作成した自動改行がない引用符付きの引用文を連結
strBody = strBody & vbCrLf & strSel
'返信メールに戻す
msgReply.Body = strBody
End If
'返信メールを表示
msgReply.Display
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
上記のマクロを呼び出すボタンをOutlookのリボンに追加する方法は下記を参考にしました。
一応Outlook2016で問題なく動作していますが、バグがあるかもしれません。
またReplyAllを使っているので既定の署名が挿入されます。
※後から署名を変更できるようにしたバージョンは、次の記事「Outlook2016の返信時に引用文の自動折り返しをしないマクロ2(署名切替対応版)」に載せました。
最後に送信時の折り返し文字数設定を忘れずに。
・Outlook 2016の場合：HKEY_Current_User\Software\Microsoft\Office\16.0\Common\MailSettings の "PlainWrapLen"に設定
(^^)
※参考にしたOUTLOOK 研究所サイト内の詳細なURLは下記になります。
