共有メールボックスの受信トレイに追加されたメールの添付ファイルを保存するマクロ


コメントにて以下のご要望をいただきました。


いつもこちらのサイトで勉強させて頂いております。

以下のマクロ(受信したメールの添付ファイルを自動保存するマクロ)を、共有メールフォルダーに対しても受信をトリガーに実行したいのですが、どのようにスクリプトを書けば良いでしょうか。

https://outlooklab.wordpress.com/2007/03/10/%E5%8F%97%E4%BF%A1%E3%81%97%E3%81%9F%E3%83%A1%E3%83%BC%E3%83%AB%E3%81%AE%E6%B7%BB%E4%BB%98%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%82%92%E8%87%AA%E5%8B%95%E4%BF%9D%E5%AD%98%E3%81%99%E3%82%8B%E3%83%9E

なお、outlook 2010を使用しています。

どうぞよろしくお願い致します。


自分自身のメールボックスの受信トレイに受信したメールについては NewMailEx イベントを使用しますが、それ以外のフォルダーに関しては、そのフォルダーの Items プロパティの ItemAdd イベントを使用します。
ただ、このイベントを使用するためには、イベントが発生するフォルダーの Items を WithEvents 句付きでグローバル変数として定義し、Application_StartUp でそのグローバル変数に該当する Items オブジェクトを格納する必要があります。

マクロは以下のようになります。

' ここをトリプルクリックでマクロ全体を選択できます。

' 共有フォルダーのイベントを取得するためのオブジェクト
Dim WithEvents sharedInboxItems As Items
'
Private Sub Application_Startup()
     ' 共有メールボックスの SMTP アドレスを指定
     Const SHARED_USER = "shareduser@example.com"
     Dim recShared As Recipient
     Dim fldSharedInbox As Folder
     ' 共有メールボックスのユーザー情報を取得
     Set recShared = Session.CreateRecipient(SHARED_USER)
     recShared.Resolve
     ' 共有メールボックスの受信トレイを取得
     Set fldSharedInbox = Session.GetSharedDefaultFolder(recShared, olFolderInbox)
     Set sharedInboxItems = fldSharedInbox.Items
End Sub
'
' 共有フォルダーの受信トレイにアイテムが追加された際に発生するイベント
Private Sub sharedInboxItems_ItemAdd(ByVal Item As Object)
     Const SAVE_PATH = "C:\temp\"
     Dim objFSO As Object ' FileSystemObject
     Dim objAttach As Attachment
     Dim strFileName As String
     Dim c As Integer: c = 1
     '
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     '
     ' 必要に応じてここで条件指定
     '
     For Each objAttach In Item.Attachments
         With objAttach
             strFileName = SAVE_PATH & objAttach.FileName
             While objFSO.FileExists(strFileName)
                 strFileName = SAVE_PATH & Left(.FileName, InStrRev(.FileName, ".") - 1) _
                     & "-" & c & Mid(.FileName, InStrRev(.FileName, "."))
                 c = c + 1
             Wend
             .SaveAsFile strFileName
         End With
     Next
     Set objMsg = Nothing
     Set objFSO = Nothing
End Sub

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

共有メールボックスの受信トレイに追加されたメールの添付ファイルを保存するマクロ」への2件のフィードバック

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中