Enviar e-mail através de resultado da fórmula
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
Discussão (2)
Carregando comentários...