How to export email addresses from outlook meeting request

Question

I sent an outlook (2010) meeting request to all company (4000+) and now I would like to send an additional email to those who accepted the request or accepted tentatively.

How do I do that? When I hit Contact Atendees --> New Email to Atendees in the ribbon it just send a response to all company and not only those who accepted. I also tried to export the contacts but it can only export the name alias and not the entire email addresses.

Any suggestions?

Thanks

Answer 1

The basis of the solution is found here Get Meeting Attendee List Macro

Here it is with minor changes.

Option Explicit

Sub GetAttendeeList()

Dim objApp As Outlook.Application
Dim objItem As Object
Dim objAttendees As Outlook.Recipients
Dim objAttendeeReq As String
Dim objAttendeeOpt As String
Dim objOrganizer As String
Dim dtStart As Date
Dim dtEnd As Date
Dim strSubject As String
Dim strLocation As String
Dim strNotes As String
Dim strMeetStatus As String
Dim strCopyData As String
Dim strCount  As String

Dim ino, it, ia, ide

Dim x As Long
Dim ListAttendees As mailitem

'On Error Resume Next

Set objApp = CreateObject("Outlook.Application")
Set objItem = GetCurrentItem()
Set objAttendees = objItem.Recipients

On Error GoTo EndClean:

' Is it an appointment
If objItem.Class <> 26 Then
  MsgBox "This code only works with meetings."
  GoTo EndClean:
End If

' Get the data
dtStart = objItem.Start
dtEnd = objItem.End
strSubject = objItem.Subject
strLocation = objItem.location
strNotes = objItem.body
objOrganizer = objItem.Organizer
objAttendeeReq = ""
objAttendeeOpt = ""

Set ListAttendees = Application.CreateItem(olMailItem)  ' <---

' Get The Attendee List
For x = 1 To objAttendees.count
   strMeetStatus = ""
   Select Case objAttendees(x).MeetingResponseStatus
     Case 0
       strMeetStatus = "No Response (or Organizer)"
       ino = ino + 1
     Case 1
       strMeetStatus = "Organizer"
       ino = ino + 1
     Case 2
       strMeetStatus = "Tentative"
       it = it + 1

       ListAttendees.Recipients.Add objAttendees(x) ' <---

     Case 3
       strMeetStatus = "Accepted"
       ia = ia + 1

       ListAttendees.Recipients.Add objAttendees(x) ' <---

     Case 4
       strMeetStatus = "Declined"
       ide = ide + 1

   End Select

   If objAttendees(x).Type = olRequired Then
      objAttendeeReq = objAttendeeReq & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf
   Else
      objAttendeeOpt = objAttendeeOpt & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf
   End If
Next

 strCopyData = "Organizer: " & objOrganizer & vbCrLf & "Subject:  " & strSubject & vbCrLf & _
  "Location: " & strLocation & vbCrLf & "Start:    " & dtStart & vbCrLf & "End:     " & dtEnd & _
  vbCrLf & vbCrLf & "Required: " & vbCrLf & objAttendeeReq & vbCrLf & "Optional: " & _
  vbCrLf & objAttendeeOpt & vbCrLf & "NOTES " & vbCrLf & strNotes

 strCount = "Accepted: " & ia & vbCrLf & _
  "Declined: " & ide & vbCrLf & _
  "Tentative: " & it & vbCrLf & _
  "No response: " & ino

'Set ListAttendees = Application.CreateItem(olMailItem)
  ListAttendees.body = strCopyData & vbCrLf & strCount
  ListAttendees.Display

  ListAttendees.Recipients.ResolveAll   ' <---

EndClean:
Set objApp = Nothing
Set objItem = Nothing
Set objAttendees = Nothing
End Sub