Ir para conteúdo
Fórum Script Brasil

Wesleyzin

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre Wesleyzin

Wesleyzin's Achievements

0

Reputação

  1. 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
×
×
  • Criar Novo...