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.
1º -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.
2º -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.
3º - 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
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.
1º -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.
2º -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.
3º - 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
Este comentário foi removido pelo autor.
ResponderEliminarGostei deste prototipo nao consegui foi que funciona-se no meu livro
ResponderEliminarGostei e funciona. no entanto depois de estar no estado "alerta", alterei as datas para fazer nova rotina e não funciona....
ResponderEliminar:), ok!! tem que verificar duas condições, o dias e estado....
ResponderEliminarmuito bom!!
ResponderEliminargostei mas gostaria que o mail destino não fosse um específico mas o correspondente à linha na coluna "F" por exemplo. Como faço?
ResponderEliminarobrigado
Bom dia Rui, conseguiu solução?
EliminarTenho a mesma demanda.
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
ResponderEliminarBoa 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?
ResponderEliminarObrigado
Pessoal, existe algum codigo vba para o envio de email com prioridade alta
ResponderEliminar