INSERIR MACRO NA PLANILHA

[Wesleyzin]

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

2 minutos atrás, Wesleyzin disse:

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