特定の名前の添付ファイルが開けなかったり、HTML メールの画像が表示されない問題について

Outlook で定期的に同じ名前の添付ファイルを受信したり、画像が埋め込まれた HTML メールを受信したりしている場合、添付ファイルが開けなくなったり、画像が赤い×印になって表示されなくなったりすることがあります。

これは、Oultook の一時フォルダに同一の名のファイルが多数作成され続けた結果、新たに同じ名前のファイルが作成できなくなった場合に発生する現象です。Outlook は同一の名前のファイルが一時フォルダに存在した場合には [1]、[2] というようにファイル名に連番を追加しますが、これが 99 まで達するとそれ以上ファイルを作成できなくなります。このような現象が発生した際には、以下の手順で Outlook の一時ファイルを削除してみてください。

1. ファイル名を指定して実行で "regedit" と入力し、[OK] をクリックします。
2. 左ペインで [マイ コンピュータ]-[HKEY_CURRENT_USER]-[Software]-[Microsoft]-[Office]-[バージョン]-[Outlook]-[Security] の順に展開します。 なお、バージョン には Outlook のバージョンごとに以下の値が入ります。
   Outlook 2010: 14.0
   Outlook 2007: 12.0
   Outlook 2003: 11.0
   Outlook 2002: 10.0
   たとえば、Outlook 2010 なら[マイ コンピュータ]-[HKEY_CURRENT_USER]-[Software]-[Microsoft]-[Office]-[14.0]-[Outlook]-[Security] になります。

3. 右ペインで [OutlookSecureTempFolder] をダブルクリックします。
4. [値のデータ] に表示される文字列をすべてコピーします。通常は "C:\Documents and Settings\ユーザー名\Local Settings\Temporary Internet Files\xxxxxxxx\" または "C:\Users\ユーザー名\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.Outlook\xxxxxxxx\ のような値です。
5. ファイル名を指定して実行でコピーした文字列を [名前] にコピーし、[OK] をクリックします。
6. 開いたフォルダにあるファイルをすべて削除します。

また、頻繁にこのような現象が発生するということであれば、以下のようなスクリプトを定期的に実行して、Outlook の一時フォルダを空にすることが可能です。

' ここをトリプルクリックでスクリプト全体を選択できます
Const OUTLOOK_VER = "14.0" ' Outlook 2007 なら 12.0、Outlook 2003 なら 11.0、Outlook 2002 なら 10.0 にする。
Dim wshShell
Dim objFSO
Dim strTempPath
Dim fldTemp
Dim fileTemp
'
Set wshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTempPath = wshShell.RegRead("HKCU\Software\Microsoft\Office\" & OUTLOOK_VER & "\Outlook\Security\OutlookSecureTempFolder")
Set fldTemp = objFSO.GetFolder(strTempPath)
'
For Each fileTemp In fldTemp.Files
    fileTemp.Delete
Next
'
Set fldTemp = Nothing
Set objFSO = Nothing
Set wshShell = Nothing

なお、通常であれば一時フォルダのファイルは自動的に削除されますが、以下のような場合に一時フォルダにファイルが残る現象が発生します。

• 添付ファイルを直接開いたまま、元のメッセージを閉じてしまった。
• 添付ファイルを開いた状態で Outlook が強制終了した。
• Outlook が一時フォルダのファイルを削除する際に、ウィルススキャンなどの要因で削除が失敗した。

添付された Excel ファイルの内容を受信の際に本文に追記するマクロ

メッセージで以下のようなご質問をいただきました。

---

弊社では、あるシステムから定期的に Excel ファイルを添付したメッセージが送信されてきます。このメッセージの添付ファイルを毎回開くのが手間なのですが、受信時に本文へ Excel のデータを自動的に埋め込むことはできないでしょうか?

---

Excel には HTML 形式で保存する機能がありますので、受信時に添付された Excel ファイルを HTML 形式で保存し、その HTML データを本文に追記することでご要望の動作が可能となるでしょう。

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

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    ImportExcelSheet EntryIDCollection
End Sub
'
Sub ImportExcelSheet(EntryIDCollection)
    Const REPORT_SUBJECT = "Daily Report *" ' マクロを実行する必要があるメッセージの件名を指定します。
    Dim objItem 'As MailItem
    Set objItem = Session.GetItemFromID(EntryIDCollection)
    ' 通常のメッセージでなければ無視
    If objItem.MessageClass <> "IPM.Note" Then
        Exit Sub
    End If
    ' 条件に合致するかどうかと添付ファイルがあるかのチェック
    If objItem.Subject Like REPORT_SUBJECT And _
        objItem.Attachments.Count = 1 Then
        Dim objAttach As Attachment
        Set objAttach = objItem.Attachments(1)
        ' 添付ファイルが Excel かどうかのチェック
        If objAttach.FileName Like "*.xls" Or objAttach.FileName Like "*.xls?" Then
            Dim objFSO 'As FileSystemObject
            Dim objShell 'As WshShell
            Dim strFileName As String
            Dim objWookbook 'As excel.Workbook
            Dim stmCss 'As TextStream
            Dim stmHtml 'As TextStream
            ' 一時フォルダに格納するためのファイル名を作成
            Set objShell = CreateObject("WScript.Shell")
            strFileName = objShell.ExpandEnvironmentStrings("%temp%\" & objAttach.FileName)
            Set objShell = Nothing
            ' 同名のファイルがすでに存在する場合は削除
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            If objFSO.FileExists(strFileName) Then
                objFSO.DeleteFile strFileName, True
            End If
            If objFSO.FileExists(strFileName & ".htm") Then
                objFSO.DeleteFile strFileName & ".htm", True
            End If
            ' 添付ファイルを保存
            objAttach.SaveAsFile strFileName
            Set objAttach = Nothing
            ' 保存したファイルを開く
            Set objWookbook = GetObject(strFileName)
            ' 最初のワークシートを HTML 形式で保存
            objWookbook.Worksheets(1).SaveAs strFileName & ".htm", 44 ' 44 = xlHtml
            objWookbook.Close
            Set objWorkbook = Nothing
            ' CSS と HTML ファイルを読み込み
            Set stmCss = objFSO.OpenTextFile(strFileName & ".files\stylesheet.css")
            Set stmHtml = objFSO.OpenTextFile(strFileName & ".files\sheet001.htm")
            ' HTML 本文の最後に HTML として保存した Excel ファイルを追加
            objItem.HTMLBody = objItem.HTMLBody & Replace(stmHtml.ReadAll, _
                "<link rel=Stylesheet href=stylesheet.css>", _
                "<style>" & vbCrLf & stmCss.ReadAll & vbCrLf & "</style>" & vbCrLf)
            objItem.Save
            Set objItem = Nothing
            stmCss.Close
            stmHtml.Close
            Set stmCss = Nothing
            Set stmHtml = Nothing
            Set objFSO = Nothing
        End If
    End If
End Sub

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

配信不能レポートに添付されたメッセージの差出人にメッセージを送信するマクロ

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

---

添付ファイルとして、メール（*.msg）ファイルが付いているメールを受信した時に、その添付msgファイル内のメール送信者に対して、自動で返信する事は可能でしょうか。
「ExchangeServer2003 + Outlook2007」の環境で、配信不能レポート（NDR）が発生した場合に、「原因となったメール」の発信者に補足情報をメール送信できないかと考えています。
ExchangeServerの設定でNDRのコピーを指定アドレスに送信できるので、現在は管理者あてに送信して手作業で都度対応していますが、これを自動化したいのです。
NDRには「原因となったメール」がmsgファイルとして添付されていますので、そこから発信者のメールアドレスを取得して、固定の件名とメッセージを本文にセットして送信できないでしょうか。
…
この対応専用のメールアカウントを用意できますので、配信不能通知に添付されている「原因メール」の送信者に
自動でメール送信さえできれば、その他は「処理済の配信不能通知」も含めて、全て削除して頂いて結構です。
むしろ、送信済メールも残らない様にして頂けると完璧です。

---

メッセージに添付された別のメッセージを MailItem オブジェクトとして直接開くことはできませんが、いったんファイルに保存してから OpenSharedItem メソッドにより開くことで、メッセージの情報を取得することが可能です。
以下は、受信したメッセージが配信不能通知だった場合に、元のメッセージの送信者にメールを自動送信し、処理後に受信メッセージなどを含めてすべて削除するサンプル コードです。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim arrEntryID
    Dim strEntryID
    Dim i As Integer
    Dim fldSent
    Dim fldDumpster
    arrEntryID = Split(EntryIDCollection, ",")
    For Each strEntryID In arrEntryID
        NotifyToNDRSender strEntryID
    Next
    ' 送信済みアイテムを削除
    Set fldSent = Session.GetDefaultFolder(olFolderSentMail)
    For i = fldSent.Items.Count To 1 Step -1
        fldSent.Items(i).Delete
    Next
    ' 削除済みアイテム フォルダを空にする
    Set fldDumpster = Session.GetDefaultFolder(olFolderDeletedItems)
    For i = fldDumpster.Items.Count To 1 Step -1
        fldDumpster.Items(i).Delete
    Next
End Sub

Private Sub NotifyToNDRSender(ByVal strEntryID As String)
    Dim repItem As Object
    Dim objFS As Object
    Dim strTemp As String
    Dim orgMail As MailItem
    Dim notifMail As MailItem
    Dim notifRec As Recipient
    ' エントリー ID からアイテムを取得
    Set repItem = Session.GetItemFromID(strEntryID)
    ' 配信不能メッセージは MessageClass が REPORT.IPM.Note.NDR となる
    If repItem.MessageClass = "REPORT.IPM.Note.NDR" Then
        ' 一時ファイルとして添付されたオリジナルのメッセージを保存
        Set objFS = CreateObject("Scripting.FileSystemObject")
        strTemp = objFS.GetSpecialFolder(2) & objFS.GetTempName() & ".msg"
        repItem.Attachments(1).SaveAsFile strTemp
        ' 保存したメッセージからアイテムを作成
        Set orgMail = Session.OpenSharedItem(strTemp)
        ' 通知用のメッセージを作成
        Set notifMail = Application.CreateItem(olMailItem)
        notifMail.Subject = "メール送信エラー" '　通知メールの件名を指定します。
        notifMail.Body = "メールの送信に失敗しました。"  ' 通知メールの本文を指定します。
        ' オリジナルのメッセージの送信者を宛先に指定
        Set notifRec = notifMail.Recipients.Add(orgMail.SenderEmailAddress)
        notifRec.Resolve
        ' 通知メッセージを送信
        notifMail.Send
        ' 元のメッセージと一時ファイルを削除
        orgMail.Delete
        objFS.DeleteFile strTemp
    End If
    ' 受信メッセージを削除
    repItem.Delete
End Sub

 

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

Outlook で HTML ソースの編集を行うマクロ

Outlook Express では HTML メールのソースを編集することができるのですが、Outlook ではその機能がありません。
そこで、Outlook で HTML メールのソースを編集するマクロを作ってみました。コードは以下の通りです。

' ここをトリプルクリックでマクロ全体を選択できます。
Sub HTMLEdit()
    Dim objShell As Object
    Dim objFso As Object
    Dim strFileName As String
    Dim stmFile As Object
'
    Set objShell = CreateObject("WScript.Shell")
    Set objFso = CreateObject("Scripting.FileSystemObject")
    strFileName = objShell.ExpandEnvironmentStrings("%temp%\") & objFso.GetTempName()
    Set stmFile = objFso.CreateTextFile(strFileName, True)
    stmFile.WriteLine ActiveInspector.CurrentItem.HTMLBody
    stmFile.Close
    objShell.Run "%windir%\notepad " & strFileName, , True
    Set stmFile = objFso.OpenTextFile(strFileName, 1)
    ActiveInspector.CurrentItem.HTMLBody = stmFile.ReadAll
    stmFile.Close
    objFso.DeleteFile strFileName
End Sub

使用方法:

1. 新規メッセージを作成します。
2. 上記のマクロを実行します。
3. メモ帳が起動しますので、HTML ソースを編集して上書き保存します。
4. メモ帳を閉じると、編集した HTML ソースがメッセージに反映されます。

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