Bom dia galera,
Tenho uma plantilha de excel que tenho um codigo VBA para enviar avisos sobre quais veiculos estão sem inspeção ou se a data estar perto.
Mas eu agora queria adicionar outras datas alem da inspeção. A ideia seria que num Range de D2:E64 ao encontrar uma data abaixo do dia de hoje ele envia se um alerta e identifica-se no email se era inspeção ou a licença de transporte que estava fora de prazo.
Outra ideia era se é possivel juntar todos os avisos de todos os veiculos num só email em vez de mandar um aviso por veiculo em cada email.
Codigo:
Sub Verificar()
Dim rCell As Range
Dim lRow, al, av As Long
Dim appOutlook As Object
Dim olMail As Object
al = 0
av = 0
ur = 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 = "NOVO" Then
End If
If rCell < (Now() + 8) Then
Dias = DateDiff("d", Now, rCell)
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)
If Dias < 0 Then
With olMail
.to = "emailll"
.Subject = "URGENTE INSPEÇÃO " & rCell(1, 0) & "- AUT."
.Body = "Passaram " & Dias & " dias da data de levar o veiculo com a matricula " & rCell(1, 0) & " à inspecção" & vbNewLine & "Mensagem enviada pelo sistema."
.Send
End With
ur = ur + 1
rCell(1, 5).Value = "URGENTE"
End If
If Dias > 0 Then
With olMail
.to = "emailll"
.Subject = "ALERTA INSPEÇÃO " & rCell(1, 0) & "- AUT."
.Body = "Faltam " & Dias & " dias para levar o veiculo com a matricula " & rCell(1, 0) & " à inspecção" & vbNewLine & "Mensagem enviada pelo sistema."
.Send
End With
al = al + 1
rCell(1, 5).Value = "ALERTADO"
End If
End If
If rCell < (Now() + 30) And rCell > (Now() + 8) Then
av = av + 1
Dias = DateDiff("d", Now, rCell)
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 = "emailll"
.Subject = "AVISO INSPEÇÃO " & rCell(1, 0) & "- AUT."
.Body = "Faltam " & Dias & " dias para levar o veiculo com a matricula " & rCell(1, 0) & " à inspecção" & vbNewLine & "Mensagem enviada pelo sistema."
.Send
End With
rCell(1, 5).Value = "AVISADO"
End If
If rCell > (Now() + 30) Then
rCell(1, 5).Value = " "
End If
vazio:
Next rCell
MsgBox ("Foram enviados " & ur & " Urgentes, " & al & " Alertas e " & av & " Avisos")
Range("K8").Value = Now()
End Sub
Podem me ajudar?