Definir Calendario

[Ramon Mattos]

Boa tarde,

Estou utilizando o código abaixo para incluir compromissos no Outlook pelo VBA, porem tenho 02 calendários (Calendário Pessoal e Calendário Profissional). O compromisso está sendo incluído corretamente, porem somente no calendário Pessoal (default), gostaria que fosse no calendário Profissional (criado). Se alguém puder me ajudar!

Private Sub Inserir_Compromisso_Outlook()

On Error GoTo Add_Err

Dim objOutlook As Outlook.Application

Dim objAppt As Outlook.AppointmentItem

Set objOutlook = CreateObject("Outlook.Application")

Set objAppt = objOutlook.CreateItem(olAppointmentItem)

With objAppt

.Start = #12/26/2011 3:00:00 PM#

.End = #12/27/2011 4:00:00 PM#

.Duration = 30

.Subject = "FLUXO DE BM´s"

.Body = "BM´S EM ATRASO"

.Location = "PCOS - Programação e Controle - Medição"

.ReminderMinutesBeforeStart = 15

.ReminderSet = True

.Save

.Close (olSave)

End With

Set objAppt = Nothing

Set objOutlook = Nothing

Set objRecurPattern = Nothing

Exit Sub

Add_Err:

MsgBox "Error " & Err.Number & vbCrLf & Err.Description

Exit Sub

End Sub