✔ Programação GLOBAL®: VBA Excel - Automatizando anotações recorrentes - Automate recurring appointments on MS Outlook

| Blog Office VBA | Blog Excel | Blog Access |

Este código serve para automatizarmos certas anotações que desejamos fiquem registradas para nossas lembranças posteriores. Isso pode ser feito dentro do MS Outlook, mas também pode ser executado fora dele em outras instancias.

Let strExcelPath = ""

Const olAppointmentItem = 1

Const olRecursWeekly = 1

Set objExcel = CreateObject("Excel.Application")

objExcel.WorkBooks.Open strExcelPath

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

Let intRow = 3

Do While objSheet.Cells(intRow, 1).Value <> ""

Let strName = objSheet.Cells(intRow, 3).Value

Let strDate = objSheet.Cells(intRow, 4).Value



    Set objOutlook = CreateObject("Outlook.Application")

    Set objAppointment = objOutlook.CreateItem(olAppointmentItem)

Let strStart = strDate & "/2013 11:00 AM"

Let strEnd = strDate & "/2099 11:00 AM"

  Let objAppointment.Start = strStart

  Let objAppointment.Duration = 30

  Let objAppointment.Subject = strName & " Event"

  Let objAppointment.Body = "Lembre-se, hoje você tem compromisso com " &strName& "' - Reunião de ..."

  Let objAppointment.Location = "Triumph Circle"

  Let objAppointment.ReminderMinutesBeforeStart = 15

  Let objAppointment.ReminderSet = True

    Set objRecurrence = objAppointment.GetRecurrencePattern

Let objRecurrence.RecurrenceType = 5

Let objRecurrence.PatternStartDate = strStart

Let objRecurrence.PatternEndDate = strEnd

    objAppointment.Save



    Set objRecurrence = nothing

    Set objAppointment = nothing

    Set objOutlook = nothing



Let intRow = intRow + 1

Loop

' Close workbook and quit Excel.

objExcel.ActiveWorkbook.Close

objExcel.Application.Quit

set objSheet = nothing

set objExcel = nothing