Outlook2000のVBAで困っています

質問

定型メール(件名は固定文字＋送信者名、添付ファイル名も固定文字＋送信者名.xls)を受信したら、添付ファイルをドライブ上のフォルダに保存し、メール本体は削除するという自動振り分けの拡張版のようなことをしたいと思い、ここ３日くらい、ネット上を彷徨っているのですが、よいサンプルがありません。どなたか是非お力をお貸しください。

回答No.2

tubumame · ベストアンサー

こんにちは。

>当方のOutlookでは、仕訳ルールの処理指定の件ですが、”スクリプトを実行する”が表示されません。

そうですか。確かに私が使用しているoutlookは2003です。
指定できないのなら仕方ありませんね。それなら以下の方法しかないでしょう。

'-------------------------------------------------
' メールを受信した際のNewMailイベントをハンドルする
' 関数
'-------------------------------------------------
Private Sub Application_NewMail()

Dim requestsFolder As MAPIFolder
Dim appNameSpace As NameSpace
Dim requestMailItem As MailItem
Dim replyMailItem As MailItem
Dim i As Integer

'受信フォルダの取得
Set appNameSpace = Application.GetNamespace("MAPI")
Set requestsFolder = appNameSpace.GetDefaultFolder(olFolderInbox)

If requestsFolder Is Nothing Then Exit Sub
DoEvents

'受信メールの件数分ループ
For i = 1 To requestsFolder.Items.Count

'新規受信メールの取得
Set requestMailItem = requestsFolder.Items.Item(i)

'メールの件名チェック
If requestMailItem.Subject = "処理対象メールの件名をここに記述" Then

'処理対象メールなので、添付ファイル保存
'メール本体削除を実行
Call SaveTempFileBeforeDeleteMail(requestMailItem)

End If

Next

End Sub

上記マクロは、outlookがメールを受信した際に発生するNewMailイベントをハンドルし、受信したメールの件数分、件名をチェックし、処理対象メールの場合は、前回作成した、SaveTempFileBeforeDeleteMailで処理をするというものです。この方法だと、仕訳ルールを作成しなくても、メールを新規受信するたびに、自動で処理が行われます。これでどうですかね？
(あまり入念に作成していないので、これを使用することによりCFfanさんが被る被害など諸問題については一切責任を負いかねますのでご了承ください。)

上記のコードでは、「件名が～に等しいとき」という条件になっていますが、CFfanさんの場合はもう少し工夫する必要があるでしょう。

回答No.1

tubumame

こんにちは。

仕訳ルールは条件と処理を指定して作成しますが、今回のケースですと、
条件 --- メールの件名
処理 --- 添付ファイルを保存し、メールは削除
となります。条件については、デフォルトで用意されているので、特に問題はないでしょう。肝心の処理については、特定のフォルダへ移動するなどの処理はデフォルトで用意されていますが、CFfanさんが行いたい処理は自作するしかありません。そこで以下のようなマクロを作成します。

'----------------------------------------------------------
' 受信したメールに添付ファイルがあれば、特定のディレクトリ
' に自動で保存し、メール本体は削除する。
' 添付ファイルが存在しない場合は何もしない。
' @param item 受信メール
'----------------------------------------------------------
Sub SaveTempFileBeforeDeleteMail(item As MailItem)

Dim i As Integer

'添付ファイルがあることを確認する。
If item.Attachments.Count <> 0 Then

'添付ファイルの件数分ループ
For i = 1 To item.Attachments.Count

'添付ファイルを指定ディレクトリに保存
item.Attachments.item(i).SaveAsFile _
"保存先のパス" + item.Attachments.item(i).DisplayName

Next
'メール本体の削除
item.Delete

End If

End Sub

上記マクロを作成したら、仕訳ルールの処理指定のところで、"スクリプトを実行する"を選択し、実行対象スクリプトとして、"SaveTempFileBeforeDeleteMail"を指定します。
以上で完了です。

説明が下手で大変申し訳ございません。

補足

tubumameさん

こんにちは。
ご連絡ありがとうございます。
一つ、質問したいことがあります。
当方のOutlookでは、仕訳ルールの処理指定の件ですが、”スクリプトを実行する”が表示されません。
Outlookのバージョンにより内容がちがうのでしょうか？
ちなみに当方はOutlook2000 SP3です。