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

Reference:

Aditya Kalra

Inspiration:

André Luiz Bernardes

Tags: VBA, Excel, Outlook, automation, automate, appointment,