Outlook.com のメールを Outlook で受信した場合のみ文字化けするメールを修正するマクロ


Outlook.com のメールを Outlook で受信している環境において、Web ブラウザでは正常に表示されるメールが以下のように文字化けすることがあります。

$B"(K\%a!<%k$O!"%;%-%e%j%F%#6/2=$N$?$a!"EE;R=pL>$r$D$1$F$*Aw$j$7$F$$$^$9!#(B

この現象は Content-Transfer-Encoding として 7bit が使用されている iso-2022-jp のメッセージで発生し、原因は Outlook が Outlook.com からメールを受信する際に iso-2022-jp に含まれる ESC (0x1b) キャラクターが欠落してしまうことにあります。

裏を返せば、欠落した ESC キャラクターを補ってデコードすれば文字化けが解消できるということになるので、そのようなことをするマクロを作りました。

なお、本文中の $B を ESC キャラクターが欠落したエスケープ シーケンスとして仮定するため、ASCII 文字として $B が含まれているメールについては別な形での文字化けになる可能性があります。

マクロは以下の通りです。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub Decode7BitJISMessage()
    Dim objMsg As MailItem
    Dim strBody As String
    Dim strNewBody As String
    Dim i As Integer
    Dim ch1, ch2 As Integer
    '
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Set objMsg = ActiveInspector.CurrentItem
    Else
        Set objMsg = ActiveExplorer.Selection(1)
    End If
    '
    If objMsg.BodyFormat = olFormatHTML Then
        strBody = objMsg.HTMLBody
    Else
        strBody = objMsg.Body
    End If
    i = InStr(strBody, "$B")
    strNewBody = ""
    While i > 0
        strNewBody = strNewBody & Left(strBody, i - 1)
        strBody = Mid(strBody, i + 2)
        While Left(strBody, 2) <> "(B" And Len(strBody) > 2
            ch1 = Asc(Mid(strBody, 1, 1))
            ch2 = Asc(Mid(strBody, 2, 1))
            If ch1 Mod 2 = 1 Then
                ch2 = ch2 + &H1F
            Else
                ch2 = ch2 + &H7D
            End If
            If ch2 >= &H7F Then
                ch2 = ch2 + 1
            End If
            ch1 = Int((ch1 - &H21) / 2) + &H81
            If ch1 >= &H9E Then
                ch1 = ch1 + &H40
            End If
            strNewBody = strNewBody & Chr(ch1 * &H100 + ch2)
            strBody = Mid(strBody, 3)
        Wend
        If Left(strBody, 2) = "(B" Then
            strBody = Mid(strBody, 3)
        End If
        i = InStr(strBody, "$B")
    Wend
    If objMsg.BodyFormat = olFormatHTML Then
        objMsg.HTMLBody = strNewBody
    Else
        objMsg.Body = strNewBody & vbCrLf & _
            "---- Original Message ----" & vbCrLf & _
            objMsg.Body
    End If
    objMsg.Save
End Sub

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

参考リンク

2941954 Outlook 2013 で Outlook.com や Hotmail で受信したメールが文字化け/「デジタル署名に問題があります」と表示

広告

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中