Print "report" for meeting/appointment with Outlook Macro

Question

I have an MS Word template that I use to print off paper where I take notes in meetings at work. I copy the subject, the list of attendees, the times and location, one-by-one and paste them into my word document. The end result is a page with a header at the top with all the elementary info about the meeting.

I'd like to automate this procedure. So naturally I have a bunch of questions to go with it:

1. How do I start a macro with some sort of pointer/indication of which calendar item I'd like it to print off?
2. Once the macro is running, how do I programmatically make a printable report and print it?

Please give me some code snippets if you can. Examples help way more than links.

Answer 1

I think the best place to start is when you have the relevant AppointmentItem open. Here's some seriously untested semi-pseudo code to get you started. First set a reference to the Word Object Library (Tools - References).

Sub MakeMeetingTemplate()

    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdRng As Word.Range
    Dim Appt As AppointmentItem

    If TypeName(ActiveInspector.CurrentItem) = "AppointmentItem" Then
        Set Appt = ActiveInspector.CurrentItem
        Set wdApp = New Word.Application
        wsApp.Visible = True
        Set wdDoc = wdApp.Documents.Add("C:\MyTemplate.doc")

        FillBookMark wdDoc.Bookmarks("MeetingName"), Appt.Subject
        FillBookMark wdDoc.Bookmarks("Attendees"), GetAttendees(Appt)
        FillBookMark wdDoc.Bookmarks("When"), Appt.Start
        FillBookMark wdDoc.Bookmarks("Location"), Appt.Location

    End If
End Sub

Sub FillBookMark(ByRef bMark As Word.Bookmark, sText As String)

    Dim wdRng As Word.Range

    Set wdRng = bMark.Range
    wdRng.Text = sText

End Sub

Function GetAttendees(Appt As AppointmentItem) As String

    Dim Rcpt As Recipient
    Dim sReturn As String

    For Each Rcpt In Appt.Recipients
        sReturn = sReturn & Rcpt.Name & " "
    Next Rcpt

    GetAttendees = sReturn

End Function

Here's what it does: Make sure the active item is an AppointmentItem. Open a Word template. Fill in predefined bookmarks in the Word doc with data from the AppointmentItem. When it's done, you'll have a Word doc with prefilled info that you can print, edit, or whatever. For more info on bookmarks in Word, see

http://www.dailydoseofexcel.com/archives/2004/08/13/automating-word/

Answer 2

For reference, here is the final code I used:

Sub PrintMeetingheader()

    'Declaration
    Dim myItems, myItem As Object
    Dim myOrt As String
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection

    Dim sDate As String
    Dim sTopic As String
    Dim sLocation As String
    Dim sAttendees As String

    Dim wdApp As Object
    Dim wdDoc As Object
    Dim wdRng As Object

    'work on selected items
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection

    'for all items do...
    For Each myItem In myOlSel
        'Check if its the right type
        If TypeName(myItem) = "AppointmentItem" Then
            'Do all sorts of stuff with the item
            sDate = Format(myItem.Start, "mm/dd")
            sDate = sDate + " ("
            sDate = sDate + Format(myItem.Start, "Medium Time")
            sDate = sDate + "-"
            sDate = sDate + Format(myItem.End, "Medium Time")
            sDate = sDate + ")"
            sTopic = myItem.Subject
            sLocation = myItem.Location
            sAttendees = myItem.RequiredAttendees

            Set wdApp = CreateObject("Word.Application")

            Set wdDoc = wdApp.Documents.Open(FileName:="C:\Meeting Notes Temp.doc", ReadOnly:=True)

            FillBookmark wdDoc, sDate, "mDate"
            FillBookmark wdDoc, sTopic, "mTopic"
            FillBookmark wdDoc, sLocation, "mLocation"
            FillBookmark wdDoc, sAttendees, "mAttendees"

            wdDoc.PrintOut True
            MsgBox ("The document was sent to the default printer.  Press OK to close it.")
            wdApp.Quit wdDoNotSaveChanges
        End If
    Next

    'free variables
    Set myItems = Nothing
    Set myItem = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing

End Sub