RPPreacher
asked on
Exporting Meeting 'Accepted'
I have a meeting on calendar sent companywide (thousands) that reads '540 attendees accepted, 12 tentatively accepted, and 1941 declined.'
I would like to export a list of just the 'attendees accepted'
Any way to do this?
I would like to export a list of just the 'attendees accepted'
Any way to do this?
ASKER
"Compile error: User-defined type not defined"
At 'Dim objApp As Outlook.Application'
Tools > References Grayed Out
At 'Dim objApp As Outlook.Application'
Tools > References Grayed Out
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
SWEEEEEEEEETTTTTT!!!!!!!
Sub PrintAapptAttendee()
' 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 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 strUnderline As String ' Horizontal divider line
' Set up Word
Dim objWord As Word.Application
Dim objdoc As Word.Document
Dim wordRng As Word.Range
Dim wordPara As Word.Paragraph
On Error Resume Next
Set objApp = CreateObject("Outlook.Appl
Set objItem = objApp.ActiveInspector.Cur
Set objSelection = objApp.ActiveExplorer.Sele
Set objAttendees = objItem.Recipients
Set objWord = GetObject(, "Word.application")
If objWord Is Nothing Then
Set objWord = CreateObject("word.applica
End If
strUnderline = String(60, "_") ' use 60 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 opten the appointment to print."
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 = ""
' Get The Attendee List
For x = 1 To objAttendees.Count
strMeetStatus = ""
Select Case objAttendees(x).MeetingRes
Case 0
strMeetStatus = "No Response (or Organizer)"
Case 1
strMeetStatus = "Organizer"
Case 2
strMeetStatus = "Tentative"
Case 3
strMeetStatus = "Accepted"
Case 4
strMeetStatus = "Declined"
End Select
If objAttendees(x).Type = olRequired Then
objAttendeeReq = objAttendeeReq & objAttendees(x).Name & vbTab & strMeetStatus & vbCr
Else
objAttendeeOpt = objAttendeeOpt & objAttendees(x).Name & vbTab & strMeetStatus & vbCr
End If
Next
' Word: Open a new doc and stuff it
objWord.Visible = True
Set objdoc = objWord.Documents.Add
Set objdoc = objWord.ActiveDocument
Set wordRng = objdoc.Range
With wordRng
.Font.Bold = True
.Font.Italic = False
.Font.Size = 14
.InsertAfter "Organizer: " & objOrganizer
.InsertParagraphAfter
.InsertAfter strUnderline
.InsertParagraphAfter
.InsertParagraphAfter
End With
Set wordPara = wordRng.Paragraphs(4)
With wordPara.Range
.Font.Bold = False
.Font.Italic = False
.Font.Size = 12
.InsertAfter "Subject: " & strSubject
.InsertParagraphAfter
.InsertAfter "Location: " & strLocation
.InsertParagraphAfter
.InsertParagraphAfter
.InsertAfter "Start: " & dtStart
.InsertParagraphAfter
.InsertAfter "End: " & dtEnd
.InsertParagraphAfter
.InsertParagraphAfter
.InsertAfter "Required: "
.InsertParagraphAfter
.InsertAfter objAttendeeReq
.InsertParagraphAfter
.InsertAfter "Optional: "
.InsertParagraphAfter
.InsertAfter objAttendeeOpt
.InsertParagraphAfter
.InsertAfter strUnderline
.InsertParagraphAfter
.InsertAfter "NOTES"
.InsertParagraphAfter
.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
If the macro errors on the "Dim objWord As Word.Application" line, add the Microsoft Word library to your project. This is under Tools / References.