By kilejohnson95757@gmail.com na sexta-feira, 01 de março de 2019
Postado em Excel
Respostas 0
Gostos 0
Visualizações 3.2K
Votos 0
Oi,
Sou novo no VBA. Eu escrevi um código para enviar um e-mail se houver uma alteração no valor da célula na coluna F, e o código funciona muito bem. Mas eu quero ter certeza de que a pasta de trabalho está salva antes de enviar o e-mail. O corpo do texto do email deve incluir o valor da célula de referência, que é o valor da coluna A da linha de valor alterado. Por favor, não use msg, não funcionará com a pasta de trabalho. A pasta de trabalho tem um formulário e carregará o valor de entrada nas células designadas. O código funciona bem com o formulário. Mas se alguém entrar na planilha e atualizar manualmente o valor, o email será enviado aos usuários, o que não quero até que o arquivo seja salvo. Por favor ajude! Desde já, obrigado.

Private Sub Worksheet_Change (ByVal Target As Range)
Dim s1, s2, s3, s4, s5, s6 como intervalo
Definir s1 = Range("F1310:F1334")
Definir s2 = Range("F1426:F1450")
Definir s3 = Range("F1339:F1363")
Definir s4 = Range("F1455:F1479")
Definir s5 = Range("F1368:F1392")
Definir s6 = Range("F1397:F1421")
On Error Resume Next
Se Target.Cells.Count> 1 Then Exit Sub
'encontra o valor alterado na coluna F
If Intersect(Target, Union(s1, s2, s3, s4, s5, s6)) não é nada, então Exit Sub
If IsNumeric(Target.Value) e Target.Value <> "" Then
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody como string
Dim xMailText como String
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
'valor de índice da coluna A da linha que o valor mudou para incluído no corpo do email
xMailText = Target.Offset(, -5).Valor
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Fatura recebida para " & xMailText & vbNewLine & vbNewLine & _
"Obrigado" & vbNewLine & vbNewLine & _
"Sr. J"
On Error Resume Next
Com xOutMail
.To = "test@gmail.com"
.CC = ""
.BCC = ""
.Assunto = "Fatura Recebida"
.Body = xMailBody
.Mandar
Terminar com
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
Se acabar
End Sub
Ver postagem completa