共有メールボックスの受信トレイのメールを Excel ファイルにエクスポートするマクロ


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


共有メールフォルダに受信したメールをエクセルに書き出したい

outlookで個人アドレスの他に2つの共有アドレスを
使用しておりそれぞれのShared Mailboxに受信したメールをいちいち検索しなければいけない業務があります。
  個人の受信フォルダーにあるメールのエクセルへの
書き出しマクロは見かけるのですが共有フォルダのものは見つけられません、
またそれらを参考に自作を試みたもののシステムエラー続きでお手上げです。
  受信時間、送信者、件名、本文(全文は不要)をエクセルに書き出すマクロを教えてください。


共有メールボックスの受信トレイを取得するには NameSpace オブジェクトの GetSharedDefaultFolder メソッドを使用します。
このメソッドで取得した Folder オブジェクトの Items に含まれるすべてのアイテムについて Excel ファイルへ受信日時などをエクスポートすればご要望は満たせるでしょう。

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

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

Public Sub ExportInboxInSharedMailboxToExcel()
     ' 共有メールボックスのメールアドレスを指定
     Const SHARED_MAILBOX = "shared1@example.com"
     ' Excel ファイルのファイル名を指定
     Const EXCEL_FILE = "c:\temp\sharedmail.xlsx"
     ' Excel ファイルに書き出す本文の最大文字数
     Const MAX_BODY_CHARS = 250
     '
     Dim recOther As Recipient
     Dim fldOtherInbox As Folder
     Dim objBook
     Dim objSheet
     Dim objItem 'As MailItem
     Dim r As Integer
     ' 共有メールボックスの受信トレイを開く
     Set recOther = Session.CreateRecipient(SHARED_MAILBOX)
     Set fldOtherInbox = Session.GetSharedDefaultFolder(recOther, olFolderInbox)
     ' Excel ファイルを開く
     Set objBook = GetObject(EXCEL_FILE)
     objBook.windows(1).Activate
     Set objSheet = objBook.sheets(1)
     ' 1 行目はタイトルとして使用し、2 行目からデータ
     r = 2
     ' データがない行まで移動
     While objSheet.Cells(r, 1) <> ""
         r = r + 1
     Wend
     ' 共有メールボックスの受信トレイのすべてのアイテムについて処理
     For Each objItem In fldOtherInbox.Items
         ' メールの情報を Excel ファイルに追記
         With objSheet
             .Cells(r, 1) = objItem.ReceivedTime
             ' 差出人の名前にアドレスが含まれない場合のみアドレスを追加
             If InStr(objItem.SenderName, objItem.SenderEmailAddress) = 0 Then
                 .Cells(r, 2) = objItem.SenderName & _
                     " <" & objItem.SenderEmailAddress & ">"
             Else
                 .Cells(r, 2) = objItem.SenderName
             End If
             .Cells(r, 3) = objItem.Subject
             .Cells(r, 4) = Left(objItem.Body, MAX_BODY_CHARS)
         End With
         r = r + 1
     Next
     ' Excel ファイルを閉じる
     objBook.Close True
End Sub

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

広告

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中