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 strCity As String
Dim folContacts As Outlook.MAPIFolder
Dim oContact As Outlook.ContactItem
Dim colItems As Outlook.Items
Dim oNS As Outlook.NameSpace
On Error Resume Next
 
Set objApp = CreateObject("Outlook.Application")

Set oNS = Application.GetNamespace("MAPI")
Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
Set colItems = folContacts.Items

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 = ""
 
' 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
     Case 3
       strMeetStatus = "Accepted"
       ia = ia + 1
     Case 4
       strMeetStatus = "Declined"
       ide = ide + 1
   End Select
   
strAttendeeName = objAttendees(x).address

Set oContact = colItems.Find("[Email1Address] = '" & strAttendeeName & "'")
         
     If Not oContact Is Nothing Then
     Debug.Print "Test", oContact.BusinessAddressCity
         strCity = oContact.MailingAddressCity & ", " & oContact.MailingAddressState
     End If
     
   If objAttendees(x).Type = olRequired Then
      objAttendeeReq = objAttendeeReq & objAttendees(x).name & vbTab & strMeetStatus & vbTab & strCity & vbCrLf
   Else
      objAttendeeOpt = objAttendeeOpt & objAttendees(x).name & vbTab & strMeetStatus & vbTab & strCity & 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 & vbCrLf & Time
  ListAttendees.Display
   
EndClean:
Set objApp = Nothing
Set objItem = Nothing
Set objAttendees = Nothing
End Sub