添付ファイルをディスクに保存し、そのファイルへのリンクをメッセージの添付ファイルと置き換えるマクロ


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


OUTLOOKで添付ファイル付きメールのやりとりの中で、転送を行なったりしていると重複した添付ファイルがメールフォルダーの中に残ってしまいます。
関係者が多いほど重複ファイルが増えてきます。
現在、手動で重複している削除したり、添付ファイルだけをローカルのフォルダーに入れて管理しています。
しかし、結構な手間が掛かるため、数ヶ月に一度、検索フォルダーで添付ファイルでフィルターし不要なものを削除しています。
マクロで次の処理ができればおもしろいと思います。
1. 添付ファイル削除】コマンドで削除あるいは保存させる。
2. および【添付ファイル保存】コマンドで保存する。その後自動削除。
3. 1. 2. のアクションの後に、メール本文の最上部に【添付ファイル XXXXは重複しているため削除済み】あるいは【添付ファイル XXXXはXXXXへ保存。削除済み】というコメントを残す。保存先を記録するのが難しい場合は【添付ファイル XXXXは保存。削除済み】でも可。
これが出来ると便利だと思います。


Outlook には添付ファイルをリンクとして追加するという機能があります。ファイルをディスクに保存し、保存したファイルへのリンクを添付することでご要望の動作は満たせるのではないかと思います。
以下は、現在開いているメッセージの添付ファイルを SAVE_DIR で指定されたフォルダに保存し、そのアイテムへのリンクを添付して、元の添付ファイルを削除するサンプルです。同じファイル名のファイルが SAVE_DIR のフォルダに既に存在する場合、ファイルに (1)、(2) という連番を付与します。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub SaveAndDeleteAttachments()
    Const SAVE_DIR = "C:\ATTACHMENTS\"
    Dim objFSO
    Dim objItem As MailItem
    Dim objAttach As Attachment
    Dim cAttach As Integer
    Dim strFileName As String
    Dim strExt As String
    Dim strBase As String
    Dim i As Integer
    Dim c As Integer
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objItem = ActiveInspector.CurrentItem
    cAttach = objItem.Attachments.Count
    For i = 1 To cAttach
        Set objAttach = objItem.Attachments(i)
        strFileName = SAVE_DIR & objAttach.FileName
        strExt = Mid(strFileName, InStrRev(strFileName, "."))
        strBase = Left(strFileName, Len(strFileName) - Len(strExt))
        c = 1
        While objFSO.FileExists(strFileName)
            strFileName = strBase & "(" & c & ")" & strExt
            c = c + 1
        Wend
        objAttach.SaveAsFile strFileName
        If objItem.BodyFormat = olFormatRichText Then
            objItem.Attachments.Add strFileName, olByReference, objAttach.Position
        Else
            objItem.Attachments.Add strFileName, olByReference
        End If
    Next
    For i = cAttach To 1 Step -1
        objItem.Attachments(i).Delete
    Next
    objItem.Save
End Sub

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

広告

添付ファイルをディスクに保存し、そのファイルへのリンクをメッセージの添付ファイルと置き換えるマクロ」への13件のフィードバック

  1. オブジェクト関数またはwith関数が設定されていません とエラーメッセージがでます。ど素人なので対処の仕方が解らないのですが。

  2. マクロをどのようにして実行してますか?
    このマクロはアイテムを開いてから実行しないと動作しません。

  3. メールを受信してそのメールを選択している状態でマクロをAlt+tでメニューを開き、Mを押し、マクロを選択して実行です。
    その他のマクロはありません。
    CドライブのルートにATTACHMENTSフォルダを作成しておいたのですが、何も保存されませんでした。難しいですね。

  4. 説明が不十分ですみません。メールを開くというのはプレビューするということではなく、メールをダブルクリックで開くということです。このマクロは、メールをダブルクリックで開かなければ正しく動作しません。選択したアイテムについて実行するには、
    Set objItem = ActiveInspector.CurrentItem
    という記述を
    Set objItem = ActiveExplorer.Selection(1)
    にする必要があります。

  5. 最近Outlookを使い出したため、このサイトはとても役立ちます。ありがとうございます。
     
    ところで、デジタル署名付の電子メールでこのマクロを動かすと、
    その場ではショートカットがついたように見えますが、
    後で見返すとショートカットが消えてしまっています。
     
    どう対処したらよいでしょうか?
    デジタル署名も一緒に削除できればよさそうなのですが、
    方法がわかりません。
     

  6. このマクロを実行したときに、以下のメッセージが出ませんか?
    「このメッセージは変更されています。変更内容を保存すると、メッセージのデジタル署名が無効になります。変更内容を保存しますか?」
    このメッセージに対し [はい] を選択すればショートカットに変更できます。
     

  7. マクロを実行したときには何のメッセージも出ません。
    もともと付いていた添付ふぁいるも削除されているので、セーブはされているようです。
    (自分で、本文を編集して保存してもやはり後で見るとショートカットが消えています。)
     
    Outlook2003 ではうまく動かないのでしょうか?

  8. Outlook 2003 で試したところ、確かにデジタル署名つきのメッセージでショートカットが消えてしまうことを確認しました。
    Outlook 2007 では発生しないので、Outlook 2003 の不具合または制限事項と思われます。

  9. やはりそうですか。残念です。
     
    署名は自分のものに置き換わるようです。どうにか署名を削除する方法があればよいのですが。

  10. 本マクロで添付ファイルのリンクを書き込まれたメッセージで、以下のような警告が表示されて、
    添付ファイルが参照不可となってしまいました。

    ”ⅰ 次の添付ファイルは問題を起こす可能性があるため、利用できなくなりました; 【添付ファイル名】へのショートカット.”

    【動作環境】
     ・ OUTLOOK 2010
     ・ Exchange サーバ

    OUTLOOK側のセキュリティ設定等で、復活できるでしょうか?
    それとも、Exchangeサーバ側の設定が影響しているのでしょうか?

    • 先程は名前を書き忘れました。豊田と申します。上記の事象の追加情報です。

      上記マクロ実行直後は、リンクの情報はメールに残っており、クリックするとリンク情報から実態のファイルを参照できるのですが、
      一旦他のメールを参照したのちに、元のメールを参照すると上記のような警告がでて、リンク情報がアクセスできない状態となります。

      セキュリティポリシが影響しているのかと考え、以下のサイトを参考に回避法(1)や(3)を行い、添付ファイルの拡張子(.zip)や
      リンクファイルの拡張子(.lnk)などをレベル1やレベル2に設定してやり直しても、現象は変わりません。
      【参考URL】
      http://office-qa.com/Outlook/ol19.htm

      デバッグして気になる点がありました。上記マクロを実行し、リンク情報が登録された時点の情報を参照したところ、
      objItem.Attachments(1).Type (元の添付ファイル情報)は ”olByValue”となっているのですが、
      objItem.Attachments(2).Type (リンク情報の添付ファイル情報)は ”2″となっていました。本来であれば、
      ”olByReference” か “4” となっているのが正しいのではないでしょうか?

      このため、本マクロ実行直後(まだリンク情報が参照できる状態)に、DeleteLinkedFilesInDeletedItems マクロでリンク情報を
      削除させようとすると、以下の行でFALSEとなってしまっています。
      If objAttach.Type = olByReference Then

      私の環境(Exchangeサーバ)が悪さをしているのでしょうか?

  11. 2014/2/3の豊田様のコメントとほぼ同じ事象がOutlook 2013でも発生しています。まだ、対処方法がコメントされていないようですが、是非とも
    回答をお願いします。また、添付ファイルを保存するフォルダを個別に指定できるように修正することは可能でしょうか?

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中