Solved

Exporting Meeting 'Accepted'

Posted on 2006-10-31
4
606 Views
Last Modified: 2008-03-17
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?
0
Comment
Question by:RPPreacher
  • 2
4 Comments
 
LVL 18

Expert Comment

by:Serena Hsi
ID: 17843419
http://www.outlookcode.com/codedetail.aspx?id=37

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.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(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).MeetingResponseStatus
     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.
0
 
LVL 20

Author Comment

by:RPPreacher
ID: 17843795
"Compile error:  User-defined type not defined"
At 'Dim objApp As Outlook.Application'

Tools > References Grayed Out
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 17845198
Hi RPPreacher,

Here's another slightly different approach.  Follow these instructions to use it.

1.  Start Outlook.
2.  Click Tools->Macro->Visual Basic Editor.
3.  If not already expanded, expand Modules and click on Module1.
4.  Copy the code below and paste it into the right-hand pane of the VB Editor.
5.  Edit the code as desired.  I placed a comment line on the line above where somethings nneds to be changed.
6.  Click the diskette icon on the toolbar to save the changes.
7.  Close the VB Editor.
8.  Click Tools->Macro->Security.
9.  Change the Security Level setting to Medium.
10.  Select (click on) an appointment.
11.  Run the macro (Tools->Macro->Macros).  It produces a text file you can print from Notepad or any program that handles text files.

Sub MeetingResponseStatus()
    Dim olkAppointment As Outlook.AppointmentItem, _
        olkRecipient As Outlook.Recipient, _
        objFSO As Object, _
        objFile As Object
    Set olkAppointment = Application.ActiveExplorer.Selection(1)
    If olkAppointment.Class = olAppointment Then
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        'Change the file name and path as desired
        Set objFile = objFSO.CreateTextFile("C:\eeTesting\Attendees.txt")
        objFile.WriteLine "Meeting: " & olkAppointment.Subject
        objFile.WriteLine " Starts: " & olkAppointment.Start
        objFile.WriteLine ""
        objFile.WriteLine "The following staff accepted the meeting request"
        objFile.WriteLine ""
        For Each olkRecipient In olkAppointment.Recipients
            If olkRecipient.MeetingResponseStatus = olResponseAccepted Then
                objFile.WriteLine olkRecipient.Name
            End If
        Next
    End If
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    Set olkRecipient = Nothing
    Set olkAppointment = Nothing
    MsgBox "All done!"
End Sub

Cheers!
0
 
LVL 20

Author Comment

by:RPPreacher
ID: 17848945
SWEEEEEEEEETTTTTT!!!!!!!
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Learn more about how the humble email signature can be used as more than just an electronic business card. When used correctly, a signature can easily be tailored for different purposes by different departments within an organization.
Check out this infographic on what you need to make a good email signature that will work perfectly for your organization.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now