Lista das funções do Excel (em PowerBI)

segunda-feira, 28 de janeiro de 2013

Enviar email de alerta pelo Excel

No outro dia fui desafiado a criar uma forma de criar alertas em Excel.
Especificamente, pretendia-se que quando determinada célula atingi-se um certo valor o Excel envia-se um email para alertar para esse facto.
Claro que já todos nós sabemos que não há impossíveis no Excel!
Por isso aqui fica um tutorial de como realizar essa tarefa com a ajuda do VBA.


Decidi aproveitar o livro que já tinha utilizado num outro artigo (Criar Alertas com a Combinação Condicional em Excel) porque a ideia base é muito similar. Desta vez o objectivo não é criar um alerta visual mas sim correr uma macro que verifique e alerte por email.
A macro vai analisar todas as células desde D2 até à ultima célula escrita comparando a data escrita com a data actual.



-Verifica se a célula está vazia. Caso se verifique, avisa o utilizador com uma mensagem e após o Ok avança para a próxima célula.



-Verifica se a diferença entre a data prevista e a data de hoje é menor que 8 e o estado está em Avisado.
Note que ambas as condições têm de ser verdadeiras. Caso se verifique envia um email com o titulo de ALERTA e no corpo do email o texto: Faltam x dias para levar o veiculo com a matricula y à inspecção  Além disso muda o estado para Alerta. Assim evita a repetição dos alertas.

- Verifica se a diferença entre a data prevista e a data de hoje é menor que 30 e o estado está em Aberto. Caso isso se verifique, envia um email com o titulo de AVISO e no corpo do email o texto: Faltam x dias para levar o veiculo com a matricula y à inspecção. Além disso muda o estado para Avisado.

No final dá uma mensagem com o relatório dos envios.



Pode transferir o livro de exemplo, aqui. Não se esqueça de activar o conteúdo antes de clicar no botão Verificar (azul). Ajuste o valor das datas se necessário para verificar o seu funcionamento. Altere o email de envio para o seu próprio, pelo menos para experimentar.
Se desejar aplicar esta Macro a um livro seu deve fazer as alterações necessárias. Este livro é apenas um modelo ou protótipo.


Sub Alerta()
    Dim rCell As Range
    Dim lRow, al, av As Long
    Dim appOutlook As Object
    Dim olMail As Object
    al = 0
    av = 0
    lRow = Range("D1048576").End(xlUp).Row
    For Each rCell In Range("D2:D" & lRow)
        If rCell = Empty Then
        MsgBox ("Falta a data da proxima inspecção do veiculo " & rCell(1, 0))
        GoTo vazio
        End If
        If rCell - Now() < 8 And rCell(1, 2) = "Avisado" Then
        al = al + 1
            On Error Resume Next
            Set appOutlook = GetObject(, "Outlook.Application")
            If appOutlook Is Nothing Then
                Set appOutlook = CreateObject("Outlook.Application")
            End If
            On Error GoTo 0
            Set olMail = appOutlook.CreateItem(0)
            With olMail
                .to = "seuemail@xpto.com" 'altere para o email de destino
                .Subject = "ALERTA"
                .Body = "Faltam " & DateDiff("d", Now, rCell) & " dias para levar o veiculo com a matricula " & rCell(1, 0) & " à inspecção"
                .Send
            End With
            rCell(1, 2).Value = "Alerta"
        End If
        If rCell - Now() < 30 And rCell(1, 2) = "Aberto" Then
        av = av + 1
        On Error Resume Next
            Set appOutlook = GetObject(, "Outlook.Application")
            If appOutlook Is Nothing Then
                Set appOutlook = CreateObject("Outlook.Application")
            End If
            On Error GoTo 0
            Set olMail = appOutlook.CreateItem(0)
            With olMail
                .to = "seuemail@xpto.com" 'altere para o email de destino
                .Subject = "AVISO"
                .Body = "Faltam " & DateDiff("d", Now, rCell) & " dias para levar o veiculo com a matricula " & rCell(1, 0) & " à inspecção"
                .Send
            End With
        rCell(1, 2).Value = "Avisado"
        End If
vazio:
    Next rCell
MsgBox ("Foram enviados " & al & " Alerta e " & av & " Avisos")
End Sub


Por: Paulo Costa
       pcosta71@gmail.com

9 comentários:

  1. Este comentário foi removido pelo autor.

    ResponderEliminar
  2. Gostei deste prototipo nao consegui foi que funciona-se no meu livro

    ResponderEliminar
  3. Gostei e funciona. no entanto depois de estar no estado "alerta", alterei as datas para fazer nova rotina e não funciona....

    ResponderEliminar
  4. :), ok!! tem que verificar duas condições, o dias e estado....

    ResponderEliminar
  5. gostei mas gostaria que o mail destino não fosse um específico mas o correspondente à linha na coluna "F" por exemplo. Como faço?
    obrigado

    ResponderEliminar
    Respostas
    1. Bom dia Rui, conseguiu solução?
      Tenho a mesma demanda.

      Eliminar
  6. Oi, tentei corre o script acima, tenho um erro na condicao If rCell - Now() < 8 And rCell(1, 0) = "Avisado" Then podes ajudar a explicar detalhadamente o script

    ResponderEliminar
  7. Boa tarde, há possibilidade de fazer esse aleta para mim, com base numa tabela de Excel que tenho de manutenção de frota e em que quando muda de cor, está na altura de enviar a notificação por e-mail?

    Obrigado

    ResponderEliminar