Nesse artigo você aprenderá a como criar um sistema de agendamento Excel completo para sua empresa ou empresa onde trabalha. É um sistema todo construído em Excel VBA com integração Outlook.
Com esse sistema Excel VBA, você poderá agendar visitas de clientes, reuniões, eventos, contas a pagar, viagens e qualquer outro tipo de compromisso, ou atividade que precise ser lembrada, de forma moderna e profissional.
A integração entre Excel e o Outlook é feita através da ativação da Referencia Microsof Outlook 16.0 Object Library, que nos permitirá acessar as propriedades do Outlook.
Os envios de notificação será realizado através da propriedade .Recipients.Add(“”).Type, onde iremos adicionar o e-mail pessoal de cada convidado ou participante do evento a ser agendado. Junto a essa propriedade voce deverá informa o tipo de status ou papel que cada um terá dentro desse evento. Os tipos a serem usados são: olOptional, olOrganizer, olRequired ou olResource. Para que o envio ocorra corretamente, devemos adicionar no final do nosso código o comando .send, que ficará encarregado de enviar um e-mail de notificação e salvar esse agendamento na agenda individual de cada um.
- olOrganizer – atribuída aos organizadores
- olOptional – informa presença do tipo não obrigatória
- olRequired – indica presença do tipo obrigatória
- olResource – atribuição do tipo recurso (ex.: documentos)
O tempo de lembrete é feito através do uso da propriedade .ReminderMinutesBeforeStart, que nos permitirá informar o tempo exato que queremos notificar os convidados antes do incio do evento agendado. Ao realizar um agendamento de uma reunião com membros de sua empresa, por exemplo, e selecionar um tempo de 10 minutos como lembrete, significa que todos os envolvidos receberão uma nova notificação 10 minutos antes do início da reunião, evitando assim, faltas ou atrasos.
Uma outra propriedades super importante do Outlook é a .GetRecurrencePattern.RecurrenceType, encarrega de informar os tipo de recorrência que queremos. As principais e mais utilizadas são: olRecursDaily, olRecursWeekly, olRecursMonthly, olRecursYearly. Para que você entenda como essa propriedade irá trabalhar, imagine que você tenha contas que devem ser pagas todos os meses em datas específicas antes do vencimento, ao fazer o agendamento, você indica Recorrência do tipo Mensal, depois a data desejada, e assim, o sistema ficará encarregado de avisar você todos os meses da data de vencimento daquela conta.
- olRecursDaily – Recorrência diária
- olRecursWeekly – Recorrência semanal
- olRecursMonthly – Recorrência mensal
- olRecursYearly – Recorrência anual
Para anexar documentos aos agendamentos você pode fazer uso da propriedade .Attachments.Add. Para isso, basta você indica essa propriedade em seu código seguido do caminho onde o documento que você deseja compartilhar está armazenado. Para utilizar todas essas e outras propriedades utilize os códigos disponibilizados abaixo para desenvolver suas próprias aplicações dentro daquilo que você precisa, e assim ter seu próprio Sistema de agendamento Excel VBA integrado ao Outlook.
Principais Vantagens do Sistema:
- Integração Excel VBA/Outlook
- Envio de notificações
- Alerta de Atraso
- Solicitação de resposta
- Anexo de Documentos
- Opções de Recorrência diária, semanal, mensal e anual
Sub SalvarAgend()
Dim ApOutlook As Outlook.Application
Dim NvCompromisso As Outlook.AppointmentItem
Dim ObRecipient As Outlook.Recipient
Dim olRecorrencia As RecurrencePattern
Set ApOutlook = New Outlook.Application
Set NvCompromisso = ApOutlook.CreateItem(olAppointmentItem)
With NvCompromisso
.MeetingStatus = olMeeting
.Subject = "Corte Masculino" & " | " & "Cliente: Marcelo do Nascimento" & " — " & "Funcionário: José Antônio"
.Location = "Studio Nascimento"
.Start = "27/06/2021" & " 8:30"
.Duration = 180
.ReminderMinutesBeforeStart = 10
.body = "Agendamento realizado"
.BodyFormat = olFormatHTML
.Categories = "Categoria Azul"
' .Recipients.Add("").Type = olOptional
' olOptional
' olOrganizer
' olRequired
' olResource
' .GetRecurrencePattern.RecurrenceType
' olRecursDaily
' olRecursWeekly
' olRecursMonthly
' olRecursYearly
' .GetRecurrencePattern.PatternEndDate
.Save
' .Send
End With
Set NvCompromisso = Nothing
Set ApOutlook = Nothing
End Sub
If txtInicio.Value = "" Or hInicial.Value = "" Or txtDuracao.Value = "" Or txtCliente.Value = "" _
Or txtServico.Value = "" Or txtFuncionario.Value = "" Then
MsgBox "Preencha todos os campos obrigatórios", vbExclamation, "Campo Vazio!"
Exit Sub
End If
If txtLocal.Value = "" Then
MsgBox "Insira o Local!", vbExclamation, "Local não Estabelecido!"
Exit Sub
End If
If txtCategoria.Value = "" Then
MsgBox "Selecione a Categoria!", vbExclamation, "Categoria!"
Exit Sub
End If
If txtRelembrar.Value = "" Then
MsgBox "Escolha o tempo para Notificar o Cliente!", vbExclamation, "Notificação!"
Exit Sub
End If
If txtMsgNotif.Value = "" Then
MsgBox "Escreva uma curta mensagem para o Cliente!", vbExclamation, "Mensagem!"
Exit Sub
End If
If optSim = True Then
If optDiaria = False And optSemanal = False And optMensal = False And optAnual = False Then
MsgBox "Ao marcar a opção de Recorrência, você deve escolher também o tipo de recorrência!", _
vbExclamation, "Tipo de Recorrência não selecionado!"
Exit Sub
Else
If txtDataFinal.Value = "" Then
MsgBox "Defina a data de término da Recorrencia!", vbExclamation, "Data de témino não preechida!"
Exit Sub
End If
End If
End If
'CalendarioClass
Public WithEvents lblDtSel As MSForms.label
Private Sub lblDtSel_Click()
Dim vSel As String
If Left(lblDtSel.Name, 1) = "l" Then
vSel = lblDtSel.Tag
AgendaSistema.Controls(btData).Text = vSel
AgendaSistema.frCalend.Visible = False
End If
End Sub
Dim BtAtual() As CalendarioClass
Dim ObjetoBt As Object
Dim btSelec As Long
ReDim BtAtual(1 To Me.Controls.Count)
For Each ObjetoBt In Me.Controls
If TypeName(ObjetoBt) = "Label" Then
btSelec = btSelec + 1
Set BtAtual(btSelec) = New CalendarioClass
Set BtAtual(btSelec).lblDtSel = ObjetoBt
End If
Next ObjetoBt
Set ObjetoBt = Nothing
ReDim Preserve BtAtual(1 To btSelec)
'Carrega os horários para as combobox's 'Duração da tarefa' e 'Tempo de Lemrete'
Sub hInicio()
Dim i As Integer
Dim f As Integer
Dim interv As Integer
interv = 30
For i = 7 To 21
With hInicial
.AddItem Format(i, "00") & ":00"
.AddItem Format(i, "00") & ":30"
End With
Next i
For f = 1 To 12
With txtDuracao
.AddItem interv
End With
interv = interv + 30
Next f
interv = 10
For f = 1 To 18
With txtRelembrar
.AddItem interv
End With
interv = interv + 10
Next f
End Sub
'Serviços
Private Sub txtServico_Change()
Dim lstCli As Range
Dim vProc As Range
Dim vCod As Range
Dim tDurac As Range
Dim vInic As Range
Dim uLin As Integer
Dim wPlan As Worksheet
Set wPlan = Planilha1
On Error Resume Next
Me.ListServicos.Clear
If Len(Me.txtServico) = 0 Then
Call txtServico_Enter
lblServico.Visible = True
Else
uLin = Application.WorksheetFunction.CountA(wPlan.Range("B:B"))
Set lstCli = wPlan.Range("B2:B" & uLin)
Set vProc = lstCli.Find(Me.txtServico, , , xlPart)
Set vCod = vProc.Offset(0, -1)
Set tDurac = vProc.Offset(0, 1)
lblServico.Visible = False
ListServicos.Visible = True
If Not vProc Is Nothing Then
Set vInic = vProc
Do
With Me.ListServicos
.ColumnWidths = "0;190;0"
.ColumnCount = 3
.AddItem Format(vCod, "00000")
.List(ListServicos.ListCount - 1, 1) = vProc
.List(ListServicos.ListCount - 1, 2) = tDurac
End With
Set vProc = lstCli.FindNext(vProc)
Set vCod = vProc.Offset(0, -1)
Set tDurac = vProc.Offset(0, 1)
Loop Until vProc.Address = vInic.Address
End If
End If
If txtServico.Value = "" Then
lblServico.Visible = True
ListServicos.Height = 162
Else
If ListServicos.ListCount < 12 Then
ListServicos.Height = (ListServicos.ListCount * 14) + 20
Else
ListServicos.Height = 162
End If
End If
End Sub
Private Sub txtServico_Enter()
Dim rg As Range
Dim linf As Integer
Dim uLin As Integer
Dim wPlan As Worksheet
On Error Resume Next
ListServicos.Visible = True
ListFuncionarios.Visible = False
listClientes.Visible = False
ListServicos.Height = 162
Set wPlan = Planilha1
uLin = Application.WorksheetFunction.CountA(wPlan.Range("B:B"))
Set rg = wPlan.Range("B2:B" & uLin)
Me.ListServicos.Clear
For linf = 1 To rg.Rows.Count
With Me.ListServicos
.ColumnWidths = "0;190;0"
.ColumnCount = 3
.AddItem Format(rg.Cells(linf, 0), "00000")
.List(ListServicos.ListCount - 1, 1) = rg.Cells(linf, 1)
.List(ListServicos.ListCount - 1, 2) = rg.Cells(linf, 2)
End With
Next
End Sub
Private Sub ListServicos_Click()
On Error Resume Next
Dim vDuracao As Integer
Dim nServico As String
vDuracao = Me.ListServicos.List(ListServicos.ListIndex, 2)
nServico = Me.ListServicos.List(ListServicos.ListIndex, 1)
txtServico.Value = nServico
txtDuracao.Value = vDuracao
ListServicos.Clear
ListServicos.Visible = False
End Sub
Sistema de agendamento Excel VBA integrado ao Outlook
