I have a macro in Outlook that pulls the responses to a meeting request, puts them in an email (formatted as a table) and sends it to the internal facilitator leading the meeting. It's working, but I'd like to add some additional functionality and all my searches have resulted in nothing helpful. I use Office365 and I have Outlook 2016 installed on my desktop. I am not a programmer!
Below is my code, the three things I want to change:
1. I would like to change the background color of each table cell based on how the person responded (strMeetStatus)
2. I want to exclude a specific internal email address from the list of email addresses populated in the table
3, I want to exclude that same specific internal email address from the To field of people receiving the email.
What I have tried:
Sub GetResponsesToMeeting()
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 strCopyResponses As String
Dim strCount As String
Dim strAttendeesToEmail As String
Dim oAccount As Outlook.Account
For Each oAccount In Application.Session.Accounts
If oAccount = " " Then
objMsg.SendUsingAccount = oAccount
End If
Next
On Error Resume Next
Set objApp = CreateObject("Outlook.Application")
Set objItem = objApp.ActiveExplorer.Selection.Item(1)
Set objAttendees = objItem.Recipients
On Error GoTo EndClean
If objItem.Class <> 26 Then
MsgBox "This code only works with meetings."
GoTo EndClean
End If
dtStart = objItem.Start
dtEnd = objItem.End
strSubject = objItem.Subject
strLocation = objItem.Location
strNotes = objItem.Body
objOrganizer = objItem.Organizer
objAttendeeReq = ""
objAttendeeOpt = ""
For x = 1 To objAttendees.Count
strMeetStatus = ""
Select Case objAttendees(x).MeetingResponseStatus
Case 0
strMeetStatus = "No Response"
ino = ino + 1
Case 1
strMeetStatus = "Organizer"
ior = ior + 1
Case 2
strMeetStatus = "Tentative"
it = it + 1
Case 3
strMeetStatus = "Accepted"
ia = ia + 1
Case 4
strMeetStatus = "Declined"
ide = ide + 1
End Select
If objAttendees(x).Type = olRequired Then
objAttendeeReq = objAttendeeReq & "" & objAttendees(x).Name & "" & "" & strMeetStatus & "" & vbCrLf
Else
objAttendeeOpt = objAttendeeOpt & "" & objAttendees(x).Name & "" & "" & strMeetStatus & "" & vbCrLf
End If
strAttendeeAddress = objAttendees(x).Address
If InStr(1, strAttendeeAddress, "/cn") & gt; 0 Then
strCopyto = objAttendees(x).Name
Debug.Print strAttendeeAddress, objAttendees(x).Name, objAttendees(x).Address
strAttendeesToEmail = strAttendeeAddress & ";" & strAttendeesToEmail
End If
Next
strCopyData = "Subject: " & strSubject & "<p>" & _
"Start: " & dtStart & "</p><p>" & "End: " & dtEnd & _
vbCrLf & vbCrLf
strCopyResponses = "Required: " & "</p>" & objAttendeeReq & "<table></table>" & vbCrLf & "Optional: " & _
vbCrLf & "" & objAttendeeOpt & "<table></table>"
strCount = "<p>Accepted: " & ia & vbCrLf & _
"<br>Declined: " & ide & vbCrLf & _
"<br>Tentative: " & it & vbCrLf & _
"<br>No response: " & ino & "<br></p>"
Set ListAttendees = Application.CreateItem(olMailItem)
ListAttendees.HTMLBody = strCopyData & "<p>" & strCopyResponses & "</p>" & "<p>" & strCount & "</p>"
ListAttendees.Display
With ListAttendees
.Subject = "Responses for: " & strSubject
.To = strAttendeesToEmail
End With
EndClean:
Set objApp = Nothing
Set objItem = Nothing
Set objAttendees = Nothing
End Sub