Jump to content
Fórum Script Brasil
  • 0

INSERIR MACRO NA PLANILHA


Question

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 = "[email protected]" '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 = "[email protected]" '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 = "[email protected]" '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 = "[email protected]" '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    
Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Cloud Computing


  • Forum Statistics

    • Total Topics
      148871
    • Total Posts
      644871
×
×
  • Create New...