スナックelve 本店

バツイチ40代女の日記です

共有メールの受信ボックスのメールのリストを取得する

きっかけは共有メールにくるお客さんのメールを担当者に転送しなくちゃいけなくてメアド一覧で欲しいなぁーと思ったところから。
送信年月日, 送信者名, 送信者メールアドレスのCSVCSV_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