Ajuda -Email Automático
Enviado: 11 Dez 2018 às 18:47
Saudações,
Preciso que o código subcitado envie um e-mail automáticamente quando a quantidade de dias na coluna de "está vencido a quanto tempo" seja igual ou maior que quinze, porém o evento change que estou usando só me permite caso eu altere o valor da celula (que é feito por formula), mesmo se não mudar, só manda o email quando clico na celula, e queria o fazer quando abrisse a planilha ou quando salva-se, que ai conseguiria agendar uma tarefa para abrir a planilha todo dia e me enviar o email ou setar um macro para salvar e ainda assim enviar o email, alguem sabe de alguma solução que não utiliza o evento change ou como automatizar isso da melhor maneira?
exemplo da planilha:
1 coluna = equipamento
2 coluna = identificacao
3 coluna = data de calibração
4 coluna = modelo
5 coluna = status (if 8 >= "15" then "programar calibração")
6 coluna = email enviado? (sim ou nada)
7 coluna = =today()
8 coluna = dias fora de calibração (column7-column3)
Codigo:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OutApp As Object
Dim OutMail As Object
Dim texto As String
linha = ActiveCell.Row - 1
If Target.Address = "$H$" & linha Then
If Plan1.Cells(linha, 8) >= 15 And Plan1.Cells(linha, 6) <> "SIM" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
texto = "Prezado responsável" & vbCrLf & vbCrLf & _
" O equipamento " & Plan1.Cells(linha, 1) & " de serial number " & _
Plan1.Cells(linha, 2) & " terá sua calibração vencida no dia " & _
Plan1.Cells(linha, 3) & vbCrLf & vbCrLf & _
"Favor programar calibração do equipamento." & _
"CRC: " & _
vbCrLf & vbCrLf & _
"Atenciosamente," & vbCrLf & "Calibração bot"
End If
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Body = texto
.Display 'send para enviar
End With
On Error Resume Next
Set OutMail = Nothing
Set OutApp = Nothing
If Plan1.Cells(linha, 6) <> "SIM" Then
Plan1.Cells(linha, 6) = "SIM"
End If
End If
End Sub
Preciso que o código subcitado envie um e-mail automáticamente quando a quantidade de dias na coluna de "está vencido a quanto tempo" seja igual ou maior que quinze, porém o evento change que estou usando só me permite caso eu altere o valor da celula (que é feito por formula), mesmo se não mudar, só manda o email quando clico na celula, e queria o fazer quando abrisse a planilha ou quando salva-se, que ai conseguiria agendar uma tarefa para abrir a planilha todo dia e me enviar o email ou setar um macro para salvar e ainda assim enviar o email, alguem sabe de alguma solução que não utiliza o evento change ou como automatizar isso da melhor maneira?
exemplo da planilha:
1 coluna = equipamento
2 coluna = identificacao
3 coluna = data de calibração
4 coluna = modelo
5 coluna = status (if 8 >= "15" then "programar calibração")
6 coluna = email enviado? (sim ou nada)
7 coluna = =today()
8 coluna = dias fora de calibração (column7-column3)
Codigo:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OutApp As Object
Dim OutMail As Object
Dim texto As String
linha = ActiveCell.Row - 1
If Target.Address = "$H$" & linha Then
If Plan1.Cells(linha, 8) >= 15 And Plan1.Cells(linha, 6) <> "SIM" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
texto = "Prezado responsável" & vbCrLf & vbCrLf & _
" O equipamento " & Plan1.Cells(linha, 1) & " de serial number " & _
Plan1.Cells(linha, 2) & " terá sua calibração vencida no dia " & _
Plan1.Cells(linha, 3) & vbCrLf & vbCrLf & _
"Favor programar calibração do equipamento." & _
"CRC: " & _
vbCrLf & vbCrLf & _
"Atenciosamente," & vbCrLf & "Calibração bot"
End If
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Body = texto
.Display 'send para enviar
End With
On Error Resume Next
Set OutMail = Nothing
Set OutApp = Nothing
If Plan1.Cells(linha, 6) <> "SIM" Then
Plan1.Cells(linha, 6) = "SIM"
End If
End If
End Sub