Monday

Automate recurring appointments on MS Outlook



Here is another piece of code that is fun when it comes to automating data from excel and setting up outlook recurring appointments.

strExcelPath = ""


Const olAppointmentItem = 1
Const olRecursWeekly = 1

Set objExcel = CreateObject("Excel.Application")
objExcel.WorkBooks.Open strExcelPath
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

intRow = 3
Do While objSheet.Cells(intRow, 1).Value <> ""
    strName = objSheet.Cells(intRow, 3).Value
    strDate = objSheet.Cells(intRow, 4).Value
   
    Set objOutlook = CreateObject("Outlook.Application")
    Set objAppointment = objOutlook.CreateItem(olAppointmentItem)

    strStart = strDate & "/2012 11:00 AM"
    strEnd = strDate & "/2099 11:00 AM"
    objAppointment.Start = strStart
    objAppointment.Duration = 30
    objAppointment.Subject = strName & " Birthday Reminder"
    objAppointment.Body = "Today is " &strName& "'s Birthday!"
    objAppointment.Location = "Team Decides"
    objAppointment.ReminderMinutesBeforeStart = 15
    objAppointment.ReminderSet = True

    Set objRecurrence = objAppointment.GetRecurrencePattern
    objRecurrence.RecurrenceType = 5
    objRecurrence.PatternStartDate = strStart
    objRecurrence.PatternEndDate = strEnd

    objAppointment.Save
   
    Set objRecurrence = nothing
    Set objAppointment = nothing
    Set objOutlook = nothing
 
    intRow = intRow + 1
Loop

' Close workbook and quit Excel.
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
set objSheet = nothing
set objExcel = nothing

Happy automating!

1 comment:

  1. Technology Specific Guide for QTP is a new book that has got great feedback from all the readers. More on feedback and where to buy the book from here:
    http://bluemagic-automation.blogspot.in/

    ReplyDelete