[VBA] Outlookでメールの添付ファイルを削除する:Outlook VBA

Outlookで特定フォルダおよびそのサブフォルダ内の特定キーワードを含む添付ファイルを削除するVBA


概要

 Outlookには、添付ファイルを管理する機能がありません。jpg,pdf,doc,excelなど日々いろいろなファイルが添付され送られてくることでしょう。この添付ファイル、ハードディスクに保存することは出来ても、なんとOutlook上から消すことは出来ません。また、気づくとOutlookのデータファイルであるpstファイルがとんでもなく肥大化していることもザラです。
 そこで、いろいろと添付ファイルを削除するファイルを検索してみたのですが、そういった日本製のツールも見つかりませんでした。そこで、Outlook VBAで自作することにしました。

VBAコード

Option Compare Text

Sub SetFolder()
Dim olApp As Outlook.Application
Dim nspNameSpace As NameSpace
Dim fldFolder As MAPIFolder
Dim strAttachFileName As String

Dim intDelCount As Integer
Dim lngDelFileSize As Long

Set olApp = New Outlook.Application ' Application オブジェクト
Set nspNameSpace = olApp.GetNamespace("MAPI") ' Namespace オブジェクト
Set fldFolder = nspNameSpace.PickFolder

Dim blDelSubFolder As Boolean

If fldFolder Is Nothing Then
Exit Sub
End If

strAttachFileName = InputBox("検索する添付ファイル名の名前の一部を入れてください")

If StrPtr(strAttachFileName) = 0 Then
Exit Sub
End If

If MsgBox("サブフォルダの削除も行いますか?", vbYesNo) = vbYes Then
blDelSubFolder = True
Else
blDelSubFolder = False
End If

Call DelAttachments(fldFolder, blDelSubFolder, strAttachFileName, _
intDelCount, lngDelFileSize)

MsgBox (intDelCount & "件," & Format(lngDelFileSize / 1024, 0) & _
"KBの添付ファイルを削除しました")

End Sub

Sub DelAttachments(fldFolder As Outlook.MAPIFolder, _
ByVal blDelSubFolder As Boolean, _
ByVal strAttachFileName As String, _
ByRef intDelCount As Integer, _
ByRef lngDelFileSize As Long)

Dim objItem As Object
Dim dteCreateDate As Date
Dim strSubject As String
Dim strItemType As String
Dim intCounter As Integer
Dim objAttachment As Attachments

Dim strOutputMessage As String

On Error Resume Next

'フォルダ内のすべてのアイテムに再帰関数
If blDelSubFolder And fldFolder.Folders.Count > 0 Then
For Each objItem In fldFolder.Folders
Call DelAttachments(objItem, blDelSubFolder, strAttachFileName, intDelCount, lngDelFileSize)
Next objItem
End If

'フォルダにアイテムがあり、それがメールであるか確認
If fldFolder.Items.Count > 0 And fldFolder.Items(1).Class = olMail Then
'フォルダ内のアイテムを削除するか確認する
' If MsgBox("Folder '" & fldFolder.Name & "' (Contains " & fldFolder.Items.Count & _
" items) の添付ファイルを削除しますか?", vbYesNo, 添付ファイルの削除) = vbYes Then

For Each objItem In fldFolder.Items
With objItem
intCounter = .Attachments.Count
Do While intCounter > 0
If .Attachments(intCounter).FileName Like ("*" & strAttachFileName & "*") Then
lngDelFileSize = lngDelFileSize + .Size
.Attachments.Remove intCounter
.Save
lngDelFileSize = lngDelFileSize - .Size
intDelCount = intDelCount + 1
End If
intCounter = intCounter - 1
Loop
End With
Next objItem
' End If
End If

End Sub


導入方法

 まず、[ツール]-[マクロ]-[Visual Basic Editor]から、Visual Basic Editorを起動します。上のVBAコードをコピーして、適当なモジュールファイルか、ThisOutlookSessionに貼り付けてください。
 さらに、[ツール]-[マクロ]-[セキュリティ]から、マクロのセキュリティレベルを『中』にする必要があります(要再起動)。ただ、マクロの実行を許可することで、マクロウィルスへの感染の危険性も高まりますので、気をつけてください。

使い方

 [ツール]-[マクロ]-[マクロ]から、SetFolderを実行します。対象フォルダを選択し、添付ファイル名の一部を入力することで、対象ファイルを削除します。
 おすすめは、拡張子での指定です。部分一致ですので、ワイルドカードは必要ありません。また、大文字・小文字の区別もしません。『.pdf』などを指定するとよいでしょう。
 サブフォルダも対象にするか聞いてきますので、必要に応じて選んでください。

補足事項

 VBA実行後は、Outlookデータファイルの圧縮(最適化)を忘れずに!!データファイルが小さくなります

posted by うずまき at 21:24 | Comment(6) | TrackBack(0) | VBA
この記事へのコメント
はじめまして。

添付ファイル鬱陶しいですねー。

上記のスクリプト使ってみましたが
メッセージボックスは出てきますが
削除が実行されませんでした。

●環境
winXP Home SP2
OutLook2000

セキュリティレベルは指定通り、中です。

ブラウザからコピペすると
改行がなくなってまうので
ソースをコピって
を\nに変換しました。

うーん…。
Posted by ほげほげ at 2007年11月30日 14:51
今頃、コメントに気づきました。申し訳ありません。

書いてなかったので申し訳ないのですが、私の環境は「Outlook2003」です。

2000は、家にないのですが、どっかにあるかもしれないので、確認してみます。
Posted by うずまき7号 at 2007年12月09日 21:58
いえいえー。
お返事ありがとうこざいますー。
2003でしたか。

web調べたり、入門書買って
なんとかしようとしたんですが
エクセル関係はあるんですが
Outlookのマクロの資料っていい感じのがないんですw
んで、エクセルのマクロから始めろって事なんですが
やりたいことに対して遠回りすぎて
二の足踏んでますw

マイクロソフトのVBAもバージョンいろいろ
ありそうで困りますねw

ではでは。
Posted by ほげほげ at 2007年12月17日 11:54
outlook2003ですが、上記のマクロをコピペして
(改行が崩れるので自分で見たとおりに整列して)マクロ実行しますが、フォルダ指定まで行って削除はされません。セキュリティは中ですが、何か設定間違いがあるのでしょうか?
Posted by MACAN at 2008年03月14日 08:07
はじめまして!
会社でOutLook使ってるんですが、(OutLook2003)
メールボックスサイズに制限があって頻繁に整理する必要があるけど
メール本文は消したくないし。。で、大変困っていましたが、このスクリプトで何とかなりそうです。
でも、このページからCut,Pasteすると改行コードが抜けてしまって整形に苦労しました。。
添付ファイルが1回では消えなかったりするんですが、何回か繰返すと消えるみたいです。
いずれにしても、今まで本文ごと消すしかなかったので、大変助かってます。
ありがとうございました!

Posted by K.I at 2008年07月08日 10:51
はじめまして。

VBA使用させて頂きました。
凄い助かりました。
他の皆さんがコピペで改行しないで苦労されているようですが、Excelにコピペ→VBAにコピペで苦労なく出来るみたいです。
有難う御座いました。
Posted by じゅびろん at 2008年11月05日 17:43
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

この記事へのTrackBack URL

×

この広告は1年以上新しい記事の投稿がないブログに表示されております。