Ir para conteúdo
Fórum Script Brasil
  • 0

INSERIR MACRO NA PLANILHA


Wesleyzin

Pergunta

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    
Link para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,8k
×
×
  • Criar Novo...