受信したメールを添付ファイル名に従って別のフォルダに移動するExcelVBA

スポンサーリンク

仕訳ルールでは対応できない条件の設定

私の職場ではOutlookのメールのやり取りをすることが非常に多く、色々な報告書や申込書が送られてきます。

送られてきたメールは報告や申込の単位でフォルダ管理をしているのですが、同じ送信元でも色々なメールが来るため仕訳ルールを使っての分類ができなくて不便でした。

今回、送られてくるメールを自動で仕分けることができるように、添付ファイルに特定の文字を持つメールだけを別のフォルダに移動するExcelVBAコードを考えてみました。

添付ファイルのファイル名を調べて特定の文字を含むメールを他のフォルダに移動するExcelVBAコード

今回作成したサンプルコードは受信トレイに入っているすべてのメールについて、1つ目の添付ファイルのファイル名を調べます。
そして添付ファイルのファイル名に「11月申込書」という文字が入っていた場合、そのメールを移動先のフォルダに移動する(もしくはコピーする)VBAコードです。

メールの数をカウントして順に進めていきますが、フォルダを移動させるとメールの数が減り、後のメールのインデックス番号が変わってしまうため、繰り返しはインデックス番号の大きいものから順に行う流れにしています。

ExcelVBAで作成していますが、PowerPoint,Word,Accessなどでも動作すると思います。
(OutlookVBAでは「oApp」の宣言など不要なコードが入っているのでそのままだと動作しません。)

Sub Outlook添付ファイル名でフォルダ移動()

Dim oApp As New Outlook.Application
Dim oAcct
Dim oStore

Dim 受信トレイ
Dim 移動先フォルダ
Dim n

Dim cITEM

Set oAcct = oApp.Session.Accounts(“アカウント名(メールアドレスなど)”)
Set oStore = oAcct.DeliveryStore

Set 受信トレイ = oStore.GetDefaultFolder(6)
Set 移動先フォルダ = 受信トレイ.Folders(“移動先フォルダ名”)

’移動先フォルダ.Display ’移動先フォルダを表示する場合このコードを実行

For n = 受信トレイ.Items.Count To 1 Step -1

Set cITEM = 受信トレイ.Items(n)
If cITEM.Attachments.Count <> 0 Then
If InStr(cITEM.Attachments(1).DisplayName, 月 & “11月申込書”) >= 1 Then
’cITEM.Copy ’元のフォルダにアイテムを残しておきたい場合、このコードを有効にする
cITEM.Move 移動先フォルダ
End If
End If
Set cITEM = Nothing
DoEvents
Next

Set 移動先フォルダ = Nothing
Set 受信トレイ = Nothing
Set oStore = Nothing
Set oAcct = Nothing

End Sub

スポンサーリンク

メールの移動とコピーについて

Outlookを操作する際のコピーの機能はExcel上の操作と異なるり、「Paste(貼り付け)」がありません。
「Copy(コピー)」を実行した段階でコピーが作成されるので慣れないとメールが大量にコピーされたり予想しない挙動を示すことがあります。

コメント