With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.
Sub RecipientReport() Const xlWorkbookDefault = 51 Dim olkMessage As Outlook.MailItem, _ olkRecipient As Outlook.Recipient, _ excApp As Object, _ excBook As Object, _ excSheet As Object, _ lngRow As Long Set excApp = CreateObject("Excel.Application") Set excBook = excApp.Workbooks.Add() Set excSheet = excBook.Worksheets(1) excApp.Visible = True With excSheet .Cells(1, 1) = "Subject" .Cells(1, 2) = "To" .Cells(1, 3) = "Delivered" .Cells(1, 4) = "Read" End With lngRow = 2 For Each olkMessage In Application.ActiveExplorer.Selection excSheet.Cells(lngRow, 1) = olkMessage.Subject For Each olkRecipient In olkMessage.Recipients With olkRecipient excSheet.Cells(lngRow, 2) = olkRecipient.Address Select Case .TrackingStatus Case olTrackingDelivered excSheet.Cells(lngRow, 3) = olkRecipient.TrackingStatusTime Case olTrackingNotDelivered Case olTrackingRead excSheet.Cells(lngRow, 4) = olkRecipient.TrackingStatusTime Case olTrackingNotRead Case olTrackingNone End Select End With lngRow = lngRow + 1 Next Next Set excSheet = Nothing 'Change the file name and path on the next line' excBook.SaveAs "C:\eeTesting\Message Tracking.xlsx", xlWorkbookDefault excBook.Close True Set excBook = Nothing Set excApp = Nothing Set olkRecipient = Nothing Set olkMessage = Nothing MsgBox "Done", vbInformation + vbOKOnly, "Recipient Report" End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
|Outlook 2010 hyperlink issue||3||42|
|where is outlook 2016 getting the names it shows in the to line on an incoming email??||4||21|
|Excel Add-in Subscript out of range||5||29|
|VBA Lookup Problem||2||11|
Join the community of 500,000 technology professionals and ask your questions.