none
Enviar email com avisos - Duvidas RRS feed

  • Pergunta

  • 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?


    • Editado P Gomes - quinta-feira, 6 de dezembro de 2018 09:39 ocultar dados pessoais
    quinta-feira, 6 de dezembro de 2018 09:38