Retrieve Meeting Response Text Associated with an Appointment

Status
Not open for further replies.
P

Peter646

How do I retrieve the text of meeting responses associated with an appointment?

I have redeveloped a macro which produces a word document listing the

meeting response status of invitees to an appointment. I would like, for

those who declined, to include the body of the meeting response (ie., where

the invitee has chosen to "Edit response before sending." While the Meeting

Response Status is a Recipient property, the text of the response is not.

Any ideas? I'm including the macro below:

Public Sub PrintAttendees()

' Gather data from an opened appointment and print to

' Word. This provides a way to print the attendee list with their

' response, which Outlook will not do on its own.

' Set up Outlook

Dim objApp As Outlook.Application

Dim objItem As Object

Dim objSelection As Selection

Dim objAttendees As Outlook.Recipients

Dim objAttendeeReqNR As String

Dim objAttendeeReqO As String

Dim objAttendeeReqT As String

Dim objAttendeeReqA As String

Dim objAttendeeReqD As String

Dim objAttendeeOptNR As String

Dim objAttendeeOptO As String

Dim objAttendeeOptT As String

Dim objAttendeeOptA As String

Dim objAttendeeOptD As String

Dim countAttendeeNR As Integer

Dim countAttendeeO As Integer

Dim countAttendeeT As Integer

Dim countAttendeeA As Integer

Dim countAttendeeD As Integer

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 strUnderline As String ' Horizontal divider line

' Set up Word

Dim objWord As Object

Dim objdoc As Object

Dim wordRng As Object

Dim wordPara As Object

On Error Resume Next

Set objApp = CreateObject("Outlook.Application")

Set objItem = objApp.ActiveInspector.CurrentItem

Set objSelection = objApp.ActiveExplorer.Selection

Set objAttendees = objItem.Recipients

Set objWord = GetObject(, "Word.application")

If objWord Is Nothing Then

Set objWord = CreateObject("word.application")

End If

strUnderline = String(50, "_") ' use 50 underline characters

On Error GoTo EndClean:

' check for user problems with none or too many items open

Select Case objSelection.Count

Case 0

MsgBox "No appointment was opened. Please open one appointment."

GoTo EndClean:

Case Is > 1

MsgBox "Too many items were selected. Just select one!!!"

GoTo EndClean:

End Select

' Is it an appointment

If objItem.Class <> 26 Then

MsgBox "You First Need To open The Appointment to Print."

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 = ""

countAttendeeNR = 0

countAttendeeO = 0

countAttendeeT = 0

countAttendeeA = 0

countAttendeeD = 0

' Get The Attendee List

For x = 1 To objAttendees.Count

If objAttendees(x).Name = strLocation Then

GoTo EndofLoop

End If

strMeetStatus = ""

Select Case objAttendees(x).MeetingResponseStatus

Case 0

strMeetStatus = "No Response"

Case 1

strMeetStatus = "Organizer"

Case 2

strMeetStatus = "Tentative"

Case 3

strMeetStatus = "Accepted"

Case 4

strMeetStatus = "Declined"

End Select

If objAttendees(x).Type = olRequired Then

If objAttendees(x).MeetingResponseStatus = 0 Then

If objAttendees(x).Name = objOrganizer Then

objAttendeeReqO = objAttendeeReqO & objAttendees(x).Name & vbTab

& "Organiser" & vbCr

countAttendeeO = countAttendeeO + 1

Else

objAttendeeReqNR = objAttendeeReqNR & objAttendees(x).Name &

vbTab & strMeetStatus & vbCr

countAttendeeNR = countAttendeeNR + 1

End If

Else

If objAttendees(x).MeetingResponseStatus = 1 Then

objAttendeeReqO = objAttendeeReqO & objAttendees(x).Name & vbTab

& strMeetStatus & vbCr

countAttendeeO = countAttendeeO + 1

Else

If objAttendees(x).MeetingResponseStatus = 2 Then

objAttendeeReqT = objAttendeeReqT & objAttendees(x).Name &

vbTab & strMeetStatus & vbCr

countAttendeeT = countAttendeeT + 1

Else

If objAttendees(x).MeetingResponseStatus = 3 Then

objAttendeeReqA = objAttendeeReqA & objAttendees(x).Name

& vbTab & strMeetStatus & vbCr

countAttendeeA = countAttendeeA + 1

Else

objAttendeeReqD = objAttendeeReqD & objAttendees(x).Name

& vbTab & strMeetStatus & vbCr

countAttendeeD = countAttendeeD + 1

End If

End If

End If

End If

Else

If objAttendees(x).MeetingResponseStatus = 0 Then

objAttendeeOptNR = objAttendeeOptNR & objAttendees(x).Name & vbTab &

strMeetStatus & vbCr

countAttendeeNR = countAttendeeNR + 1

Else

If objAttendees(x).MeetingResponseStatus = 1 Then

objAttendeeOptO = objAttendeeOptO & objAttendees(x).Name & vbTab

& strMeetStatus & vbCr

countAttendeeO = countAttendeeO + 1

Else

If objAttendees(x).MeetingResponseStatus = 2 Then

objAttendeeOptT = objAttendeeOptT & objAttendees(x).Name &

vbTab & strMeetStatus & vbCr

countAttendeeT = countAttendeeT + 1

Else

If objAttendees(x).MeetingResponseStatus = 3 Then

objAttendeeOptA = objAttendeeOptA & objAttendees(x).Name

& vbTab & strMeetStatus & vbCr

countAttendeeA = countAttendeeA + 1

Else

objAttendeeOptD = objAttendeeOptD & objAttendees(x).Name

& vbTab & strMeetStatus & vbCr

countAttendeeD = countAttendeeD + 1

End If

End If

End If

End If

End If

EndofLoop:

Next

' Word: Open a new doc and fill it

objWord.Visible = True

Set objdoc = objWord.Documents.Add

Set objdoc = objWord.ActiveDocument

Set wordRng = objdoc.Range

objdoc.Paragraphs.TabStops.ClearAll

objdoc.Paragraphs.TabStops.Add Position:=180

With wordRng

> Font.Bold = True

> Font.Italic = False

> Font.Size = 14

> InsertAfter "Subject: " & strSubject

> InsertParagraphAfter

> InsertAfter strUnderline

> InsertParagraphAfter

> InsertParagraphAfter

End With

Set wordPara1 = wordRng.Paragraphs(4)

With wordPara1.Range

> Font.Bold = False

> Font.Italic = False

> Font.Size = 12

> InsertAfter "Organiser:" & vbTab & objOrganizer

> InsertParagraphAfter

> InsertAfter "Location:" & vbTab & strLocation

> InsertParagraphAfter

> InsertParagraphAfter

> InsertAfter "Start: " & dtStart

> InsertParagraphAfter

> InsertAfter "End: " & dtEnd

> InsertParagraphAfter

> InsertParagraphAfter

> InsertAfter "Required: "

> InsertParagraphAfter

> InsertAfter objAttendeeReqO

> InsertAfter objAttendeeReqA

> InsertAfter objAttendeeReqT

> InsertAfter objAttendeeReqNR

> InsertAfter objAttendeeReqD

> InsertParagraphAfter

> InsertAfter "Optional: "

> InsertParagraphAfter

> InsertAfter objAttendeeOptO

> InsertAfter objAttendeeOptA

> InsertAfter objAttendeeOptT

> InsertAfter objAttendeeOptNR

> InsertAfter objAttendeeOptD

> InsertParagraphAfter

End With

Set wordPara1a = wordRng.Paragraphs.Last

With wordPara1a.Range

> Font.Size = 12

> InsertAfter "Organiser:" & vbTab & countAttendeeO & vbCr

> InsertAfter "Accepted:" & vbTab & countAttendeeA & vbCr

> InsertAfter "Tentative:" & vbTab & countAttendeeT & vbCr

> InsertAfter "No Response:" & vbTab & countAttendeeNR & vbCr

> InsertAfter "Declined:" & vbTab & countAttendeeD & vbCr

> InsertParagraphAfter

End With

Set wordPara2 = wordRng.Paragraphs.Last

With wordPara2.Range

> Font.Size = 14

> InsertAfter strUnderline & vbCr

> InsertParagraphAfter

> InsertAfter "Notes" & vbCr

> InsertParagraphAfter

End With

Set wordPara3 = wordRng.Paragraphs.Last

With wordPara3.Range

> Font.Size = 12

> InsertAfter strNotes

End With

EndClean:

Set objApp = Nothing

Set objItem = Nothing

Set objSelection = Nothing

Set objAttendees = Nothing

Set objWord = Nothing

Set objdoc = Nothing

Set wordRng = Nothing

Set wordPara = Nothing

End Sub
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
If haven't checked it, but I think you need to look at the emails, i.e.

responses, you've received in order to get the body.

Best regards

Michael Bauer

Am Tue, 8 Dec 2009 01:00:01 -0800 schrieb Peter646:


> How do I retrieve the text of meeting responses associated with an


appointment?

> I have redeveloped a macro which produces a word document listing the
> meeting response status of invitees to an appointment. I would like, for
> those who declined, to include the body of the meeting response (ie.,


where
> the invitee has chosen to "Edit response before sending." While the


Meeting
> Response Status is a Recipient property, the text of the response is not.

> Any ideas? I'm including the macro below:

> Public Sub PrintAttendees()
> ' Gather data from an opened appointment and print to
> ' Word. This provides a way to print the attendee list with their
> ' response, which Outlook will not do on its own.

> ' Set up Outlook
> Dim objApp As Outlook.Application
> Dim objItem As Object
> Dim objSelection As Selection
> Dim objAttendees As Outlook.Recipients
> Dim objAttendeeReqNR As String
> Dim objAttendeeReqO As String
> Dim objAttendeeReqT As String
> Dim objAttendeeReqA As String
> Dim objAttendeeReqD As String
> Dim objAttendeeOptNR As String
> Dim objAttendeeOptO As String
> Dim objAttendeeOptT As String
> Dim objAttendeeOptA As String
> Dim objAttendeeOptD As String
> Dim countAttendeeNR As Integer
> Dim countAttendeeO As Integer
> Dim countAttendeeT As Integer
> Dim countAttendeeA As Integer
> Dim countAttendeeD As Integer
> 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 strUnderline As String ' Horizontal divider line

> ' Set up Word
> Dim objWord As Object
> Dim objdoc As Object
> Dim wordRng As Object
> Dim wordPara As Object

> On Error Resume Next

> Set objApp = CreateObject("Outlook.Application")
> Set objItem = objApp.ActiveInspector.CurrentItem
> Set objSelection = objApp.ActiveExplorer.Selection
> Set objAttendees = objItem.Recipients

> Set objWord = GetObject(, "Word.application")
> If objWord Is Nothing Then
> Set objWord = CreateObject("word.application")
> End If

> strUnderline = String(50, "_") ' use 50 underline characters

> On Error GoTo EndClean:

> ' check for user problems with none or too many items open
> Select Case objSelection.Count
> Case 0
> MsgBox "No appointment was opened. Please open one appointment."
> GoTo EndClean:
> Case Is > 1
> MsgBox "Too many items were selected. Just select one!!!"
> GoTo EndClean:
> End Select

> ' Is it an appointment
> If objItem.Class <> 26 Then
> MsgBox "You First Need To open The Appointment to Print."
> 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 = ""
> countAttendeeNR = 0
> countAttendeeO = 0
> countAttendeeT = 0
> countAttendeeA = 0
> countAttendeeD = 0

> ' Get The Attendee List
> For x = 1 To objAttendees.Count
> If objAttendees(x).Name = strLocation Then
> GoTo EndofLoop
> End If
> strMeetStatus = ""
> Select Case objAttendees(x).MeetingResponseStatus
> Case 0
> strMeetStatus = "No Response"
> Case 1
> strMeetStatus = "Organizer"
> Case 2
> strMeetStatus = "Tentative"
> Case 3
> strMeetStatus = "Accepted"
> Case 4
> strMeetStatus = "Declined"
> End Select

> If objAttendees(x).Type = olRequired Then
> If objAttendees(x).MeetingResponseStatus = 0 Then
> If objAttendees(x).Name = objOrganizer Then
> objAttendeeReqO = objAttendeeReqO & objAttendees(x).Name &


vbTab
> & "Organiser" & vbCr
> countAttendeeO = countAttendeeO + 1
> Else
> objAttendeeReqNR = objAttendeeReqNR & objAttendees(x).Name &
> vbTab & strMeetStatus & vbCr
> countAttendeeNR = countAttendeeNR + 1
> End If
> Else
> If objAttendees(x).MeetingResponseStatus = 1 Then
> objAttendeeReqO = objAttendeeReqO & objAttendees(x).Name &


vbTab
> & strMeetStatus & vbCr
> countAttendeeO = countAttendeeO + 1
> Else
> If objAttendees(x).MeetingResponseStatus = 2 Then
> objAttendeeReqT = objAttendeeReqT & objAttendees(x).Name &
> vbTab & strMeetStatus & vbCr
> countAttendeeT = countAttendeeT + 1
> Else
> If objAttendees(x).MeetingResponseStatus = 3 Then
> objAttendeeReqA = objAttendeeReqA &


objAttendees(x).Name
> & vbTab & strMeetStatus & vbCr
> countAttendeeA = countAttendeeA + 1
> Else
> objAttendeeReqD = objAttendeeReqD &


objAttendees(x).Name
> & vbTab & strMeetStatus & vbCr
> countAttendeeD = countAttendeeD + 1
> End If
> End If
> End If
> End If
> Else
> If objAttendees(x).MeetingResponseStatus = 0 Then
> objAttendeeOptNR = objAttendeeOptNR & objAttendees(x).Name & vbTab &
> strMeetStatus & vbCr
> countAttendeeNR = countAttendeeNR + 1
> Else
> If objAttendees(x).MeetingResponseStatus = 1 Then
> objAttendeeOptO = objAttendeeOptO & objAttendees(x).Name &


vbTab
> & strMeetStatus & vbCr
> countAttendeeO = countAttendeeO + 1
> Else
> If objAttendees(x).MeetingResponseStatus = 2 Then
> objAttendeeOptT = objAttendeeOptT & objAttendees(x).Name &
> vbTab & strMeetStatus & vbCr
> countAttendeeT = countAttendeeT + 1
> Else
> If objAttendees(x).MeetingResponseStatus = 3 Then
> objAttendeeOptA = objAttendeeOptA &


objAttendees(x).Name
> & vbTab & strMeetStatus & vbCr
> countAttendeeA = countAttendeeA + 1
> Else
> objAttendeeOptD = objAttendeeOptD &


objAttendees(x).Name
> & vbTab & strMeetStatus & vbCr
> countAttendeeD = countAttendeeD + 1
> End If
> End If
> End If
> End If
> End If
> EndofLoop:
> Next

> ' Word: Open a new doc and fill it

> objWord.Visible = True
> Set objdoc = objWord.Documents.Add
> Set objdoc = objWord.ActiveDocument
> Set wordRng = objdoc.Range
> objdoc.Paragraphs.TabStops.ClearAll
> objdoc.Paragraphs.TabStops.Add Position:=180

> With wordRng
> .Font.Bold = True
> .Font.Italic = False
> .Font.Size = 14
> .InsertAfter "Subject: " & strSubject
> .InsertParagraphAfter
> .InsertAfter strUnderline
> .InsertParagraphAfter
> .InsertParagraphAfter
> End With

> Set wordPara1 = wordRng.Paragraphs(4)
> With wordPara1.Range
> .Font.Bold = False
> .Font.Italic = False
> .Font.Size = 12
> .InsertAfter "Organiser:" & vbTab & objOrganizer
> .InsertParagraphAfter
> .InsertAfter "Location:" & vbTab & strLocation
> .InsertParagraphAfter
> .InsertParagraphAfter
> .InsertAfter "Start: " & dtStart
> .InsertParagraphAfter
> .InsertAfter "End: " & dtEnd
> .InsertParagraphAfter
> .InsertParagraphAfter
> .InsertAfter "Required: "
> .InsertParagraphAfter
> .InsertAfter objAttendeeReqO
> .InsertAfter objAttendeeReqA
> .InsertAfter objAttendeeReqT
> .InsertAfter objAttendeeReqNR
> .InsertAfter objAttendeeReqD
> .InsertParagraphAfter
> .InsertAfter "Optional: "
> .InsertParagraphAfter
> .InsertAfter objAttendeeOptO
> .InsertAfter objAttendeeOptA
> .InsertAfter objAttendeeOptT
> .InsertAfter objAttendeeOptNR
> .InsertAfter objAttendeeOptD
> .InsertParagraphAfter
> End With

> Set wordPara1a = wordRng.Paragraphs.Last
> With wordPara1a.Range
> .Font.Size = 12
> .InsertAfter "Organiser:" & vbTab & countAttendeeO & vbCr
> .InsertAfter "Accepted:" & vbTab & countAttendeeA & vbCr
> .InsertAfter "Tentative:" & vbTab & countAttendeeT & vbCr
> .InsertAfter "No Response:" & vbTab & countAttendeeNR & vbCr
> .InsertAfter "Declined:" & vbTab & countAttendeeD & vbCr
> .InsertParagraphAfter
> End With

> Set wordPara2 = wordRng.Paragraphs.Last
> With wordPara2.Range
> .Font.Size = 14
> .InsertAfter strUnderline & vbCr
> .InsertParagraphAfter
> .InsertAfter "Notes" & vbCr
> .InsertParagraphAfter
> End With

> Set wordPara3 = wordRng.Paragraphs.Last
> With wordPara3.Range
> .Font.Size = 12
> .InsertAfter strNotes
> End With

> EndClean:
> Set objApp = Nothing
> Set objItem = Nothing
> Set objSelection = Nothing
> Set objAttendees = Nothing
> Set objWord = Nothing
> Set objdoc = Nothing
> Set wordRng = Nothing
> Set wordPara = Nothing

> End Sub
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
glnz How to retrieve or redo Verizon.net email password without affecting Outlook connection? Using Outlook 1
M Retrieve data from GAL and put it in Clipboard Using Outlook 1
M Outlook VBA Macro that could retrieve/display the (From, Subject, Date Received) Outlook VBA and Custom Forms 2
N How to retrieve user defined fields values to bcm form. Using Outlook 2
F Auto retrieve wont work Using Outlook 1
Chris Smith Outlook 2013 will not retrieve my IMAP mail Using Outlook 1
4 VBA - How to retrieve Meetings Saved but Not Sent? Using Outlook 0
K Outlook favorite folder disappear, how do I retrieve it back? Using Outlook 0
I Retrieve amount of calendar availability and attachments automatically Using Outlook 2
G Cannot retrieve emails past 2 weeks old Exchange Server Administration 1
R Went from outlook 2003 to 2010 - can't retrieve active for contacts Using Outlook 0
P CDO MAPI Session failing to retrieve user name but Getexchage user Outlook VBA and Custom Forms 2
J Could not retrieve IMessage: Interface not supported Outlook VBA and Custom Forms 7
S Retrieve the Mails with the attachment names changed Outlook VBA and Custom Forms 3
T Re: mailItem.HTMLBody should retrieve only current text Outlook VBA and Custom Forms 1
J Event/Meeting in Outlook Does Not Align with SharePoint Calendar Using Outlook 5
A Meeting organizer calendar intermittently drops meeting after delegate sends invite Using Outlook 0
A Meeting organizer calendar intermittently drops meeting after delegate sends invite Exchange Server Administration 0
C Create Meeting With Custom Form Outlook VBA and Custom Forms 2
diver864 vba for a rule to automatically accept meeting requests with 'vacation' in subject, change to all-day event, change to free, don't send reply Outlook VBA and Custom Forms 1
S Skype for business meeting vba code Outlook VBA and Custom Forms 1
A Unable to save recurring Meeting to Documents folder due to error Using Outlook 2
S Meeting with Time Slots Using Outlook 2
egarneau Meeting updates with external contacts (GMail) Using Outlook 1
L automaticaly create a teams meeting with a sync Using Outlook 0
R auto send email when meeting closes from a shared calendar only Outlook VBA and Custom Forms 2
S Meeting Invite arrives from Wrong ("send-as") Sender Using Outlook 1
Daniel Schunk Meeting responses are not shown in the status area Using Outlook 2
A End-time meeting reminder (or "negative" time relative to the meeting start time) Using Outlook 1
J Help Please!!! Outlook 2016 - VBA Macro for replying with attachment in meeting invite Outlook VBA and Custom Forms 9
T Pick-a-Meeting in Outlook 365 Using Outlook 2
J No response required when delegate arranging meeting Using Outlook 0
S Accepting meeting request from calendar keeps the meeting request in the inbox Using Outlook 2
D Add all meeting rooms to the meeting request by default Outlook VBA and Custom Forms 0
Rick Rickert Would like bigger meeting notifications. Using Outlook 3
G Auto accept meeting request for non primary account Outlook VBA and Custom Forms 1
D Next Available Meeting with Userform Variables Outlook VBA and Custom Forms 1
J Outlook 2016 shows Meeting Organizer in Calendar View Using Outlook 5
C Update Notes for Meeting Attendees Using Outlook 8
D Outlook macros to create meeting on shared calendar Outlook VBA and Custom Forms 10
P Skype contact icons have disappeared at the bottom of email and meeting objects Using Outlook 2
T Double clik behavior on agenda open a new meeting request Using Outlook 1
B How to get Meeting Invitations into Outlook.com calendar? Using Outlook 2
Diane Poremsky Autoaccept a Meeting Request using Rules Using Outlook 2
Diane Poremsky Close a Meeting When the Room is Full Using Outlook 0
A Attendee Update Outlook Meeting Invite Using Outlook 0
Diane Poremsky iPhone and the Meeting Request Bug Using Outlook 0
P Receiving a Meeting Declined notice for a recurring meeting Using Outlook 0
A Customize meeting form. Private notices Outlook VBA and Custom Forms 3
A VBA to create meeting from template from a time slot selected in someone's calendar Outlook VBA and Custom Forms 5

Similar threads

Top