きっかけは共有メールにくるお客さんのメールを担当者に転送しなくちゃいけなくてメアド一覧で欲しいなぁーと思ったところから。
送信年月日, 送信者名, 送信者メールアドレスのCSVをCSV_FILE に作成します。
※ExcelじゃなくてOutlookです。
Sub 共有メール一覧出力() Const SHARED_MAILBOX = "mailAddress@example.com" Const CSV_FILE = "C:\test\test.csv" Dim objOutlook As Outlook.Application Dim myNamespace As Outlook.NameSpace Dim myInbox As Outlook.Folder Dim myItem As Outlook.MailItem Dim myRecipient As Outlook.Recipient '最初にレシピエント取得する Set myRecipient = Session.CreateRecipient(SHARED_MAILBOX) Set objOutlook = New Outlook.Application Set myNamespace = objOutlook.GetNamespace("MAPI") Set myInbox = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox) Open CSV_FILE For Output As #1 '受信トレイの中のメール文ループ For Each myItem In myInbox.Items '送信年月日, 送信者名, 送信者メールアドレス Write #1, Format(myItem.SentOn, "YYYY/MM/DD"), myItem.SenderName, myItem.SenderEmailAddress Next Close #1 MsgBox "終了" End Sub
ほぼこちらのパクリです(;´Д`)
共有メールボックスの受信トレイのメールを Excel ファイルにエクスポートするマクロoutlooklab.wordpress.com
ちなみに、共用じゃない受信トレイの出力は
Sub メール一覧出力() Const CSV_FILE = "C:\test\test.csv" Dim objOutlook As Outlook.Application Dim myNamespace As Outlook.NameSpace Dim myInbox As Outlook.Folder Dim myItem As Outlook.MailItem Dim myRecipient As Outlook.Recipient Set objOutlook = New Outlook.Application Set myNamespace = objOutlook.GetNamespace("MAPI") Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox) Open CSV_FILE For Output As #1 '受信トレイの中のメール文ループ For Each myItem In myInbox.Items '送信年月日, 送信者名, 送信者メールアドレス Write #1, Format(myItem.SentOn, "YYYY/MM/DD"), myItem.SenderName, myItem.SenderEmailAddress Next Close #1 MsgBox "終了" End Sub