Excel から Outlook を使用してメールを送信した際に、送信日時を取得するためのマクロ


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


mailitem.sent プロパティについ教えてください。このプロパティに,エクセルのVBAから,アクセスできるのでしょうか。できるのなら,outlookがわとエクセルがわで必要な手順等について,ご教示ねがえればありがたいです。

エクセルVBAから,OUTLOOKを操作して,メールを送ってます。

送るのに,objItem.DisplayとobjItem.Sendを場合に分けて使ってます。

それぞれの送信処理の後に,何の判断もせずに,”送信済み”の記録をエクセルのシート
に記録しています。

何の判断もしていないので,

 objItem.Displayでは,「送信中止」「×」等で,送信をやめても”送信済み”の
 記録になってしまいます。

 objItem.Sendでは,通常は問題ないのですが,容量の大きめの添付ファイル
 を添付すると,送信されない,送信トレイにメールが残ったままになります
 が,これも”送信済み”になります。

そこで,エクセルVBA側で,ここに送ったメールの送信状態が確認できないか,
といろいろ検索しました。MailItem.Sent で,ここの送信状態が確認できるむね
を知りました。エクセルVBAで,確認できると,上記のことが解消できるのですが。


Outlook でメールの送信処理中に Sent プロパティを参照しようとするとエラーが発生します。
これは、送信処理を行っているメールについてプロパティの参照や変更が発生すると、送信処理に問題が生じるためと考えられます。
また、仮に Sent プロパティが参照できたとしても、どのタイミングで参照するのかという問題が生じます。

そのため、Outlook で送信処理が完了し、メールが送信済みアイテムに格納されたタイミングで実行される ItemAdd イベントを使用し、送信状況を確認するマクロを作成しました。
このマクロを使用するためには、Visual Basic Editor の [ツール]-[参照設定…] で [Microsoft Outlook 16.0 Object Library] のチェックボックスをオンにしておく必要があります。

既に作成されている送信マクロで objItem.Display や objItem.Send を実行する前に、下記の AddTrackInfo に objItem と送信後に送信日時を書き込むセルの行番号と列番号を指定して呼び出します。
すると、Outlook で送信処理が完了し、メールが送信済みアイテムに保存されたタイミングで自動的に mySentItems_ItemAdd が実行され、指定したセルに送信日時を書き込みます。

ただし、送信が完了する前に Excel ファイルを閉じてしまったり、完了時に Excel が応答不能状態だったりすると、送信日時が保存されませんので、Outlook で送信処理が完了するまではなるべく Excel の操作は行わないほうが良いでしょう。

なお、使い方の説明のためにサンプルとして SendExample というマクロも作っています。
これは、以下のようなワークシートの情報を読み取ってメールを送信し、送信後に送信日時が書き込まれるというものです。

A B C D
1 件名 あて先 本文 送信日時
2 送信テスト1 user1@example.com これは送信テストです。
3 送信テスト2 user2@example.com これも送信テストです。

マクロは以下の通りです。

' イベント処理のための変数
Dim WithEvents mySentItems As Items
' 送信済みになった際に記録されるようにメッセージにプロパティを設定する
Private Sub AddTrackInfo(objMail As MailItem, iRow As Integer, iCol As Integer)
     Dim olkApp As Outlook.Application
     Dim fldSentMail As Folder
     Dim strTrackInfo As String
     Dim propTrack As UserProperty
     ' 送信済みアイテム フォルダーを取得
     Set fldSentMail = objMail.Application.Session.GetDefaultFolder(olFolderSentMail)
     ' mySentItems が設定されていなければ送信済みアイテム フォルダーの Items を設定
     If mySentItems Is Nothing Then
         Set mySentItems = fldSentMail.Items
     End If
     ' メールに送信後の保存先フォルダーを設定
     Set objMail.SaveSentMessageFolder = fldSentMail
     ' 送信状況を追跡するためのプロパティを設定
     Set propTrack = objMail.UserProperties.Add("TrackInfo", olText, True)
     ' 送信日時を保存するセルの行番号と列番号を設定
     propTrack.Value = iRow & "," & iCol
End Sub
' 送信済みアイテム フォルダーにアイテムが追加されたときに実行されるイベント
Private Sub mySentItems_ItemAdd(ByVal Item As Object)
     Dim objMail As MailItem
     Dim propTrack As UserProperty
     Set objMail = Item
     ' 送信状況を追跡するプロパティの確認
     Set propTrack = objMail.UserProperties.Find("TrackInfo")
     ' プロパティが存在したら
     If Not propTrack Is Nothing Then
         Dim arrRC As Variant
         ' 送信日時を保存するセルの行番号と列番号を取得
         arrRC = Split(propTrack.Value, ",")
         ' 取得した行、列のセルに送信日時を保存
         Sheet1.Cells(CInt(arrRC(0)), CInt(arrRC(1))).Value = objMail.SentOn
     End If
End Sub
' 上記のマクロを使用するサンプル
Public Sub SendExample()
     Dim objMail As MailItem
     Dim olkApp As Outlook.Application
     Dim iRow As Integer
     '
     Set olkApp = New Outlook.Application
     With Sheet1
         iRow = 2
         While .Cells(iRow, 1) <> ""
             Set objMail = olkApp.CreateItem(olMailItem)
             objMail.Subject = .Cells(iRow, 1)
             objMail.To = .Cells(iRow, 2)
             objMail.Body = .Cells(iRow, 3)
             '
             AddTrackInfo objMail, iRow, 4
             '
             objMail.Send
             iRow = iRow + 1
         Wend
     End With
End Sub

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

コメントを残す