Site da Vetorial Treinamentos

Excel e Outlook integração

Sistema de agendamento Excel VBA integrado ao Outlook

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

Sistema de agendamento Excel - Agenda Calendário Outlook

Leave a Comment

O seu endereço de email não será publicado. Campos obrigatórios marcados com *