Notifications
Clear all

Email automático VBA

2 Posts
2 Usuários
0 Reactions
1,025 Visualizações
(@augustocap)
Posts: 0
New Member
Topic starter
 

Boa tarde pessoal!

Preciso da ajuda de vocês, fiz um código onde consigo copiar e colar dentro do email e enviar, mas isso só acontece eu apertando um botão atribuído a macro.

Estou querendo deixa lo automático.

Ex: Quando eu colocar a palavra "Concluído" ele automaticamente envia o email com todas as informações.

Esse aqui é o código que fiz.

CÓDIGO - 01
Sub Send_Range()
ActiveSheet.Range("A1:P16").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Introduction = "Senhores," _
& vbNewLine & vbNewLine & _
Plan1.Cells(19, 2) & vbNewLine & _
Plan1.Cells(20, 2) & vbNewLine & _
Plan1.Cells(21, 2) & vbNewLine & _
Plan1.Cells(22, 2) & vbNewLine & _
Plan1.Cells(23, 2)
.Item.To = Plan1.Cells(19, 13) & Plan1.Cells(20, 13)
.Item.Cc = Plan1.Cells(22, 13) & Plan1.Cells(23, 13)
.Item.Subject = "Faturas do Mês"
.Item.Send
MsgBox "Faturas Enviadas"

End With
End Sub

Esse aqui achei em pesquisa. Que é o que eu quero, mas esse aqui ele coloca em texto

CÓDIGO - 02
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OutApp As Object
Dim OutMail As Object
Dim texto As String

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

linha = ActiveCell.Row - 1
If Target.Address = "$Q$" & linha Then

If Plan1.Cells(linha, 17) = "Concluído" Then
texto = "Prezado(a) " & Plan1.Cells(linha, 1) & "," & vbCrLf & vbCrLf & _
"A O.S. " & Plan1.Cells(linha, 7) & " aberta em " & _
Plan1.Cells(linha, 2) & " foi concluída." & vbCrLf & _
" Veja informações abaixo:" & vbCrLf & _
" Status: " & Plan1.Cells(linha, 6) & vbCrLf & _
" Ação tomada: " & Plan1.Cells(linha, 5) & vbCrLf & vbCrLf & _
"Atenciosamente," & vbCrLf & _
"Help Desk"
End If

With OutMail
.To = Plan1.Cells(linha, 1)
.CC = ""
.BCC = ""
.Subject = "Teste"
.Body = texto
.Send 'Utilize Send para enviar o email sem abrir o Outlook
End With
On Error GoTo 0

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

Preciso pegar a função que está em negrito no CÓDIGO - 02 e incluir no CÓDIGO - 01, não consigo fazer isso e se alguém poder me ajudar agradeço.

 
Postado : 08/06/2018 9:36 am
(@boobymcgee)
Posts: 0
New Member
 

Veja se é isso que você quer:

 
Postado : 09/06/2018 4:29 pm