Bom dia, copiei essa Macro de um site, mas não sei como inserir na minha planilha, ela não está enviando os email. Grato!
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
QUERO APLICAR NESSA TABELA:
TAG
Prevista
Enviada
Estado
SG-01
SG-02
25/01/2021
Avisado
SG-03
25/01/2021