Click here to Skip to main content
15,887,434 members
Please Sign up or sign in to vote.
1.00/5 (1 vote)
See more:
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:

VB
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 ' add to body
    Dim strAttendeesToEmail As String ' location field for email reminder
    Dim oAccount As Outlook.Account

    For Each oAccount In Application.Session.Accounts
        If oAccount = " " Then ' had to remove email address for this to post
            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

    ' 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"
                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
Posted
Updated 3-Mar-17 16:39pm
v2
Comments
[no name] 1-Mar-17 10:00am    
"I am not a programmer", so does that mean that you want us to do work for you for free?

1 solution

Quote:
Need help tweaking a macro

You need to hire a professional coder.
Hire Freelancers & Find Freelance Jobs Online - Freelancer[^]
 
Share this answer
 

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900