Jump to content

Welcome to Geeks to Go - Register now for FREE

Geeks To Go is a helpful hub, where thousands of volunteer geeks quickly serve friendly answers and support. Check out the forums and get free advice from the experts. Register now to gain access to all of our features, it's FREE and only takes one minute. Once registered and logged in, you will be able to create topics, post replies to existing threads, give reputation to your fellow members, get your own private messenger, post status updates, manage your profile and so much more.

Create Account How it Works
Photo

Printing List from Outlook


  • Please log in to reply

#1
weinerdogs

weinerdogs

    New Member

  • Member
  • Pip
  • 2 posts
I need to print the list of attendees invited to a meeting, and their responses.
I know almost nothing about VB and macros, but I did manage to copy and paste the following code from another web site. It might as well be in Klingon, because I keep getting an error message. Can someone translate this, find the mistake, and tell me in really, really, simple English, how to make this work? Or if you have an easier method, that would be great, too. Thanks very much.


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
  • 0

Advertisements


#2
weinerdogs

weinerdogs

    New Member

  • Topic Starter
  • Member
  • Pip
  • 2 posts
In case anyone is interested, the code did indeed work. You just have to make sure that there is a reference to the Word library. Thanks anyway.
  • 0






Similar Topics

0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users

As Featured On:

Microsoft Yahoo BBC MSN PC Magazine Washington Post HP