Windows Live メールからエクスポートされたメッセージの不具合に対応するマクロ


Windows Live メールから Outlook にメッセージをエクスポートすると、そのメッセージで以下のような現象が発生します。

  • メッセージを読んでもアイコンが既読にならない。
  • 転送や返信を行っても既読にならない。
  • メールに返信してもアドレスが入力されない。

これらの現象は、Windows Live メールからエクスポートされたメッセージのプロパティが不適切だったり、必要なプロパティが存在しないために発生しています。

そこで、エクスポートされたメッセージを修正してアイコンを正常にするマクロ (FixWLMExported) と、エクスポートされたメッセージに返信するためのマクロ (ReplyAllToWLMExported) を作りました。
FixWLMExported はエクスポートされたメッセージが格納されているフォルダーを選択して実行してください。
また、ReplyAllToWLMExported は返信したいメッセージを開いて実行してください。

' ここをトリプルクリックでマクロ全体を選択できます。
'
'  アイコンを正常にするマクロ
Public Sub FixWLMExported()
    Dim objItem As MailItem
    '
    For Each objItem In ActiveExplorer.CurrentFolder.Items
        ' メッセージクラスが IPM なら IPM.Note に修正
        If objItem.MessageClass = "IPM" Then
            objItem.MessageClass = "IPM.Note"
        End If
        objItem.Save
    Next
End Sub
'
'  Windows Live メールのメッセージに返信するマクロ
Public Sub ReplyAllToWLMExported()
    Dim orgItem As MailItem
    Dim replyItem As MailItem
    Dim oneRec As Recipient
    ' アクティブなウィンドウの種別で取得するアイテムを決定
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Set orgItem = ActiveInspector.CurrentItem
    Else
        Set orgItem = ActiveExplorer.Selection(1)
    End If
    ' 返信メッセージを作成
    Set replyItem = orgItem.Reply
    ' 受信者をいったんクリア
    replyItem.To = ""
    ' 差出人を宛先に追加
    AddOneRecipient replyItem, orgItem.SenderName, orgItem.SenderEmailAddress, olTo
    ' 受信者を宛先または CC に追加
    For Each oneRec In orgItem.Recipients
        AddOneRecipient replyItem, oneRec.Name, oneRec.Address, oneRec.Type
    Next
    ' 返信メッセージを表示
    replyItem.Display
End Sub
'  受信者を追加するサブ プロシージャ
Private Sub AddOneRecipient(objItem As MailItem, strName As String, _
        strAddress As String, iType As Outlook.OlMailRecipientType)
    Dim oneRec As Recipient
    ' すでに受信者に追加されているアドレスは追加しない
    For Each oneRec In objItem.Recipients
        If oneRec.Address = strAddress Then
            Exit Sub
        End If
    Next
    If strName = strAddress Then
        ' 名前とアドレスが同じならアドレスのみで追加
        Set oneRec = objItem.Recipients.Add(strAddress)
    Else
        If strName Like "*@*" Then
            ' 名前が @ を含んでいるなら名前のみで追加
            Set oneRec = objItem.Recipients.Add(strName)
        Else ' 名前とアドレスを連結して追加
            Set oneRec = objItem.Recipients.Add(strName & " <" & strAddress & ">")
        End If
    End If
    oneRec.Type = iType
    oneRec.Resolve
End Sub

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

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中