Quantcast
Channel: Últimos conteúdos
Viewing all articles
Browse latest Browse all 14190

Enviar e-mail através de resultado da fórmula

$
0
0

Boa Tarde,
 
Estou iniciando meus estudos na área de VB para facilitar algumas tarefas do dia a dia.
 
Adaptei um código que me envia um e-mail quando alguns critérios de datas forem atingidos porém, só está funcionando quando eu digito a quantidade de dias na coluna alvo.
 
O que eu queria fazer é utilizar uma fórmula e o resultado desta fórmula ativar o código. Pelo que eu li, eu não deveria estar utilizando o procedimento CHANGE porém não entendi qual outro e como eu deveria utilizar.
 
Segue abaixo o código.
 
 
 
 


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String
    Dim prazoTrinta As Integer
    Dim prazoMax As Integer
    Dim prazoMin As Integer
    Dim prazoVencido As Integer
        

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    linha = ActiveCell.Row - 1
    prazoVencido = 0
    prazoTrinta = 30
    prazoMax = 60
    prazoMin = 57
    
    If Target.Address = "$N$" & linha Then

        If Plan1.Cells(linha, 14).Value <= prazoMax And Plan1.Cells(linha, 14).Value >= prazoMin Then
            texto = "Senhores," & vbCrLf & vbCrLf & _
                    "O Contrato / Item N° " & Plan1.Cells(linha, 5) & " faltam " & Plan1.Cells(linha, 14) & " dias para o vencimento." & vbCrLf & vbCrLf & _
                    "Atenciosamente"

                With OutMail
                .To = ""
                .CC = ""
                .BCC = ""
                .Subject = "Título do email"
                .Body = texto
                .Send
        End With
        
        ElseIf Plan1.Cells(linha, 14).Value = prazoTrinta Then
             texto = "Senhores," & vbCrLf & vbCrLf & _
                    "O Contrato / Item N° " & Plan1.Cells(linha, 5) & " faltam " & Plan1.Cells(linha, 14) & " dias para o vencimento." & vbCrLf & vbCrLf & _
                    "Atenciosamente"

                With OutMail
                .To = ""
                .CC = ""
                .BCC = ""
                .Subject = "Título do email"
                .Body = texto
                .Send
        End With
        
        ElseIf Plan1.Cells(linha, 14).Value < prazoVencido Then
            texto = "Senhores," & vbCrLf & vbCrLf & _
                    "O Contrato / Item N° " & Plan1.Cells(linha, 5) & " expirou." & vbCrLf & vbCrLf & _
                    "Atenciosamente"

                With OutMail
                .To = ""
                .CC = ""
                .BCC = ""
                .Subject = "Título do email"
                .Body = texto
                .Send
        End With
        
                    
        End If

        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
    
End Sub

Viewing all articles
Browse latest Browse all 14190

Trending Articles