Note: The other languages of the website are Google-translated. Back to English

Como enviar e-mail automaticamente com base no valor da célula no Excel?

Suponha que você queira enviar um e-mail através do Outlook para um determinado destinatário com base em um valor de célula especificado no Excel. Por exemplo, quando o valor da célula D7 em uma planilha é maior que 200, um e-mail é criado automaticamente. Este artigo apresenta um método VBA para você resolver rapidamente esse problema.

Enviar e-mail automaticamente com base no valor da célula com código VBA


Enviar e-mail automaticamente com base no valor da célula com código VBA

Faça o seguinte para enviar um e-mail com base no valor da célula no Excel.

1. Na planilha, você precisa enviar e-mail com base no valor da célula (aqui diz a célula D7), clique com o botão direito na guia da planilha e selecione Ver código no menu de contexto. Veja a imagem:

2. No popping up Microsoft Visual Basic para Aplicações janela, copie e cole o código VBA abaixo na janela de código da planilha.

Código VBA: enviar e-mail pelo Outlook com base no valor da célula no Excel

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 200 Then
        Call Mail_small_Text_Outlook
    End If
End Sub
Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Notas:

1). No código VBA, D7 Chanel valor> 200 são a célula e o valor da célula em que você enviará o email.
2). Altere o corpo do e-mail conforme necessário em xMailBody linha no código.
3). Substitua o endereço de e-mail pelo endereço de e-mail do destinatário na linha .To = "Endereço de e-mail".
4). E especifique os destinatários Cc e Bcc conforme necessário em .CC = “” Chanel Cco = “” .
5). Por fim, altere o assunto do e-mail na linha .Subject = "enviar por teste de valor de célula".

3. aperte o outro + Q chaves juntas para fechar o Microsoft Visual Basic para Aplicações janela.

A partir de agora, quando o valor inserido na célula D7 for maior que 200, um e-mail com destinatários e corpo especificados será criado automaticamente no Outlook. Você pode clicar no ENVIAR botão para enviar este e-mail. Veja a imagem:

Notas:

1. O código VBA só funciona quando você usa o Outlook como seu programa de e-mail.

2. Se os dados inseridos na célula D7 forem um valor de texto, a janela de e-mail também será exibida.


Envie e-mails facilmente pelo Outlook com base nos campos da lista de e-mails criada no Excel:

O Mande emails utilidade de Kutools for Excel ajuda os usuários a enviar e-mail através do Outlook com base na lista de mala direta criada no Excel.
Baixe e experimente agora! (30-dia de trilha livre)


Artigos relacionados:


As melhores ferramentas de produtividade para escritório

Kutools for Excel Resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Barra Super Fórmula (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2021 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Recursos completos de avaliação gratuita de 30 dias. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Guia do Office traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
parte inferior da aba do escritório
Comentários (308)
Avaliado 5 fora do 5 · classificações 1
Este comentário foi feito pelo moderador no site
Como o código deve ser modificado, para se aplicar a um intervalo inteiro de células?
Este comentário foi feito pelo moderador no site
Prezada Debbie,
Por favor, tente abaixo do código VBA para resolver o problema.

Private Sub Worksheet_Change (ByVal Target As Range)
Se Target.Cells.Count> 1 Then Exit Sub
If (Not Intersect(Target, Range("A1:D4")) é Nada) E (Target.Value > 200) Then
Ligue para Mail_small_Text_Outlook
Se acabar
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2"
On Error Resume Next
Com xOutMail
.To = "Endereço de e-mail do seu destinatário"
.CC = ""
.BCC = ""
.Subject = "enviar por teste de valor de célula"
.Body = xMailBody
.Exiba 'ou use .Enviar
Terminar com
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
Estou tendo problemas para obter este código para solicitar se o valor na célula for alterado indiretamente. Por exemplo, se eu tiver a equação Sum alterando esse valor automaticamente. Quando a equação é executada e o valor ultrapassa o valor definido para solicitar o e-mail, isso não ocorre, a menos que eu mesmo altere fisicamente o número. Existe uma maneira de fazer o prompt de e-mail mesmo se alterado indiretamente?
Este comentário foi feito pelo moderador no site
Caro Jordan,
O código VBA a seguir pode ajudá-lo a resolver o problema. Não se esqueça de substituir o "Endereço de e-mail" pelo endereço de e-mail do destinatário no código. Obrigada.

Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRgPre como intervalo
On Error Resume Next
Se Target.Cells.Count> 1 Then Exit Sub
Definir xRg = intervalo ("D7")
Definir xRgPre = xRg.Precedentes
Se xRg.Value > 200 Então
Se Target.Address = xRg.Address Then
Ligue para Mail_small_Text_Outlook
ElseIf (não xRgPre é nada) e (Intersect(Target, xRgPre).Address = Target.Address) Then
Ligue para Mail_small_Text_Outlook
Se acabar
Se acabar
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2"
On Error Resume Next
Com xOutMail
.To = "Endereço de e-mail"
.CC = ""
.BCC = ""
.Subject = "enviar por teste de valor de célula"
.Body = xMailBody
.Exiba 'ou use .Enviar
Terminar com
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
Modifiquei o código sugerido para tentar fazê-lo funcionar para meu aplicativo.
Alterado xRg = Range("C2:C40") e If xRg.Value = -1.

O problema que estou tendo é sempre que houver uma alteração em qualquer célula e, desde que uma das células no meu intervalo seja = -1, ela chamará Mail_small_Text_Outlook.
Estou tentando chamar apenas se alguma célula no meu intervalo for alterada indiretamente para -1.
Eu também queria saber se e como seria possível que ele atendesse a dois critérios.
Como verificar o intervalo A e o intervalo B e se eles atendem aos critérios, chame a função.

Obrigado antecipadamente pela ajuda. Eu sou novo em tudo isso, mas lendo este tópico me levou cerca de 90% lá.


Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRgPre como intervalo
On Error Resume Next
Se Target.Cells.Count> 1 Then Exit Sub
Definir xRg = Range("C2:C40")
Definir xRgPre = xRg.Precedentes
Se xRg.Value = -1 Então
Se Target.Address = xRg.Address Then
Ligue para Mail_small_Text_Outlook
ElseIf (não xRgPre é nada) e (Intersect(Target, xRgPre).Address = Target.Address) Then
Ligue para Mail_small_Text_Outlook
Se acabar
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Eu usei este código com a única mudança que eu apliquei a uma coluna inteira [Set xRg = Range("D4:D13")]. Agora, o evento é acionado sempre que um cálculo é feito, independentemente de a válvula na Coluna D estar abaixo do valor alvo. Alguma idéia do porquê disso?


Dim Xrg como intervalo
Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRgPre como intervalo
On Error Resume Next
Se Target.Cells.Count> 1 Then Exit Sub
Set Xrg = Range("D4:D13")
Definir xRgPre = Xrg.Precedentes
Se Xrg.Value < 1200 Então
Se Target.Address = Xrg.Address Then
Ligue para Mail_small_Text_Outlook
ElseIf (não xRgPre é nada) e (Intersect(Target, xRgPre).Address = Target.Address) Then
Ligue para Mail_small_Text_Outlook
Se acabar
Se acabar
End Sub

Sub Mail_small_Text_Outlook()
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Oi" & vbNewLine & _
"Testar vba" _
& vbNewLine & _
"Linha 2."
On Error Resume Next
Com xOutMail
.Para = ""
.CC = ""
.BCC = ""
.Subject = "Teste automático de e-mail"
.Body = xMailBody
.Exibição
Terminar com
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada

End Sub


Obrigado.
Este comentário foi feito pelo moderador no site
Olá

Estou tendo problemas porque o destinatário de e-mail precisa ser adicionado várias vezes, um por um. Por favor, informe se a lista de destinatários de e-mail pode ser adicionada a esta função para que a função selecione o endereço de e-mail da lista de endereços de e-mail fornecida ou upload da lista e a função envie o e-mail, já composto, para o destinatário desejado.
Este comentário foi feito pelo moderador no site
Caro Henrique,
O código VBA a seguir pode ajudá-lo a resolver o problema. Por favor, coloque o script VBA em seu módulo de planilha. Quando o valor na célula especificada atende à condição, um Kutools for Excel caixa de diálogo aparecerá, selecione as células que contêm os endereços de e-mail dos destinatários e clique no botão OK. Em seguida, os e-mails com destinatários especificados são abertos. Por favor, envie-os como você precisa.

Private Sub Worksheet_Change (ByVal Target As Range)
Se Target.Cells.Count> 1 Then Exit Sub
Definir xRg = intervalo ("D7")
Se xRg = Alvo e Alvo.Valor > 200 Então
Ligue para Mail_small_Text_Outlook
Se acabar
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Dim xRgMsg como intervalo
Dim xCell como intervalo
Set xRgMsg = Application.InputBox("Selecione as células de endereço:", "Kutools for Excel", , , , , , 8)
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2"
On Error Resume Next
Para cada xCell em xRgMsg
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
Com xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Subject = "enviar por teste de valor de célula"
.Body = xMailBody
.Exiba 'ou use .Enviar
Terminar com
xOutApp = Nada
xOutMail = Nada
Seguinte
Em erro GoTo 0
End Sub
Este comentário foi feito pelo moderador no site
será enviado automaticamente por correio, sem qualquer interrupção manual
Este comentário foi feito pelo moderador no site
Prezado Brahma,
Se você deseja enviar o e-mail diretamente sem exibir, substitua a linha ".Display" por ".Send" no código VBA acima.
Este comentário foi feito pelo moderador no site
Oi eu coloquei o mesmo script mas não está funcionando por favor me ajude na 1ª parte

Dim xRg como intervalo

Private Sub Worksheet_Change (ByVal Target As Range)
Se Target.Cells.Count> 1 Then Exit Sub
Definir xRg = intervalo ("D7")
Se xRg = Alvo e Alvo.Valor = 200 Então
Ligue para Mail_small_Text_Outlook
Se acabar

End Sub
Este comentário foi feito pelo moderador no site
Caro manjericão,
Há algum aviso ao executar o código?
Este comentário foi feito pelo moderador no site
Olá, como você modificaria este código para verificar se um grupo de células tem a string "No match" e enviar um email se tiver.
Este comentário foi feito pelo moderador no site
Caro José,
Por favor, tente abaixo do código VBA. Ao executar o código, uma caixa de diálogo é exibida, selecione o intervalo que você verificará para string e clique no botão OK. se a string não existir, você receberá uma caixa de diálogo de prompt. Se a string existir no intervalo, um email com destinatário, assunto e corpo especificados será exibido.

Sub Enviar E-mail()
Escurecer eu enquanto
Dim J enquanto
Dim xRg como intervalo
Dim xArr
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Dim xFlag como booleano
On Error Resume Next
Set xRg = Application.InputBox("Selecione o intervalo", "Kutools for Excel", Selection.Address, , , , , 8)
Se xRg não for nada, saia do sub
xArr = xRg.Valor
xFlag = Falso
Para I = 1 Para UBound(xArr)
Para J = 1 Para UBound(xArr, 2)
Se xArr(I, J) = "Sem correspondência" Então
xFlag = Verdadeiro
Se acabar
Seguinte
Seguinte
Se xFlag Então
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2"
Com xOutMail
.To = "Endereço de e-mail"
.CC = ""
.BCC = ""
.Assunto = "Corresponder"
.Body = xMailBody
.Exiba 'ou use .Enviar
Terminar com
Outro
MsgBox "Não encontrado nenhum valor correspondente", vbInformation, "KuTools for Excel"
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Como eu poderia alterar este código para enviar as notas dos alunos aos pais. Onde se a coluna A é a nota e a Coluna B é o e-mail pai. Quero preencher um e-mail para cada aluno com nota F.
Este comentário foi feito pelo moderador no site
Caro Franco,
O código VBA abaixo pode ajudá-lo a resolver o problema. Obrigada.

Sub Mail_small_Text_Outlook()
Dim xRg como intervalo
Escurecer eu enquanto
Escurecer xRows por muito tempo
Dim xVal como string
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
On Error Resume Next
Set xRg = Application.InputBox("Selecione a coluna de nota e a coluna de e-mail (duas colunas)", "Kutools for Excel", Selection.Address, , , , , 8)
Se xRg não for nada, saia do sub
xRows = xRg.Rows.Count
Defina xRg = xRg(2)
Para I = 1 Para xLinhas
xVal = xRg.Offset(I, -1).Texto
Se xVal = "F" Então
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a nota do seu filho" & xRg.Offset(I, -1).Texto
Com xOutMail
.to = xRg.Offset(I, 0).Texto
.Subject = "enviar por teste de valor de célula"
.Body = xMailBody
.Exiba 'ou use .Enviar
Terminar com
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
Se acabar
Seguinte
End Sub
Este comentário foi feito pelo moderador no site
Tenho uma lista de endereços de e-mail já em um arquivo excel, como posso modificar o código para escolher automaticamente o endereço de e-mail da pessoa se seu celular D7 for >200?
Este comentário foi feito pelo moderador no site
Bom dia,
O código VBA a seguir pode ajudá-lo a resolver o problema. Por favor, coloque o script VBA em seu módulo de planilha. Quando o valor na célula especificada atende à condição, um Kutools for Excel caixa de diálogo aparecerá, selecione as células que contêm os endereços de e-mail dos destinatários e clique no botão OK. Em seguida, os e-mails com destinatários especificados são abertos. Por favor, envie-os como você precisa.

Private Sub Worksheet_Change (ByVal Target As Range)
Se Target.Cells.Count> 1 Then Exit Sub
Definir xRg = intervalo ("D7")
Se xRg = Alvo e Alvo.Valor > 200 Então
Ligue para Mail_small_Text_Outlook
Se acabar
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Dim xRgMsg como intervalo
Dim xCell como intervalo
Set xRgMsg = Application.InputBox("Selecione as células de endereço:", "Kutools for Excel", , , , , , 8)
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2"
On Error Resume Next
Para cada xCell em xRgMsg
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
Com xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Subject = "enviar por teste de valor de célula"
.Body = xMailBody
.Exiba 'ou use .Enviar
Terminar com
xOutApp = Nada
xOutMail = Nada
Seguinte
Em erro GoTo 0
End Sub
Este comentário foi feito pelo moderador no site
Estou tendo problemas para enviar e-mail através do Outlook. Recebo o erro dizendo "Um programa está tentando enviar um e-mail em seu nome. Se for inesperado, negue e verifique se o software antivírus está atualizado"
Por favor me ajudem, pois não consigo automatizar.
Este comentário foi feito pelo moderador no site
Desculpe Mayank,
O código funciona bem no meu caso. Parece que algo sobre a função "enviar em nome" está configurado no seu Outlook. Verifique por favor.
Este comentário foi feito pelo moderador no site
Olá, qual código eu usaria se estivesse tentando enviar um e-mail para um gerente que possui uma lista das frutas que tem uma quantidade > 200 uma vez por mês (com base no seu exemplo) ou expira em breve (com base nas datas)
Este comentário foi feito pelo moderador no site
Good Day
Pode ser o método neste artigo "Como enviar e-mail se a data de vencimento foi cumprida no Excel?" pode ajudá-lo.
Por favor, siga este link: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
Este comentário foi feito pelo moderador no site
Como posso editar o código para enviar um email com base em uma data na célula. Por exemplo, preciso de um documento revisado a cada 15 meses e quero enviar um e-mail em 12 meses para um endereço de e-mail informando que o documento precisa ser revisado. Eu tenho agora para enviar um e-mail automaticamente alterando .Display para .Send e funciona muito bem como está escrito, mas o que eu preciso mudar para usar uma função de data em vez de um número inteiro?
Este comentário foi feito pelo moderador no site
Como você pode adicionar vários intervalos a "Set xRg = Range("D7")". Eu quero editá-lo e adicionar Range("D7:F7"). No entanto, estou recebendo um erro de Run Time Error 13, Type Mismatch e está me levando para If xRg = Target And Target.Value > 2 Then.


Como posso resolver este problema?
Este comentário foi feito pelo moderador no site
Bom dia,
Por favor, tente abaixo do código VBA para resolver o problema.

Private Sub Worksheet_Change (ByVal Target As Range)
Se Target.Cells.Count> 1 Then Exit Sub
If (Not Intersect(Target, Range("D7:F7")) é Nada) E (Target.Value > 200) Then
Ligue para Mail_small_Text_Outlook
Se acabar
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2"
On Error Resume Next
Com xOutMail
.To = "Endereço de e-mail do seu destinatário"
.CC = ""
.BCC = ""
.Subject = "enviar por teste de valor de célula"
.Body = xMailBody
.Exiba 'ou use .Enviar
Terminar com
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
funcionou perfeitamente bem.. Obrigado..:):)
Este comentário foi feito pelo moderador no site
Não está funcionando para mim, pois o valor em D7 é resultado de um formal. E se a célula D7 contiver uma fórmula, por exemplo, D7 =2*120? Ele ainda atende a condição, mas nada está acontecendo. Por favor ajude
Este comentário foi feito pelo moderador no site
como parar a execução do código, ou seja, não solicitar o e-mail quando a condição não for atendida?

mesmo quando D7 < 200, ainda recebo o e-mail.
Este comentário foi feito pelo moderador no site
Bom dia,
O código está atualizado no post com o problema resolvido. Obrigado pelo seu comentário.
Este comentário foi feito pelo moderador no site
Hi

Muito obrigado por postar este código VBA e instruções. Quando o encontrei, senti como se tivesse ganhado na loteria. No entanto, estou preso em algo, então espero que você possa ajudar (sou novo no VBA, só tenho um entendimento muito básico).

Copiei o código e alterei a célula e o valor da célula para escolher de um intervalo se um critério for atendido. Eu tentei e testei e funciona e recebi um e-mail para o Outlook com base nos critérios.

1) No entanto, não consigo descobrir como fazer com que o código VBA seja executado automaticamente quando abro a planilha do Excel, em vez de clicar no aplicativo VBA e selecionar executar. Você poderia informar se há um prompt adicional para digitar no código VBA acima que fará isso ou deve ser feito separadamente.

2) Também existe uma maneira de obter o código VBA para enviar um e-mail para uma pessoa se a data de vencimento for sim para um determinado item, conforme mostrado no exemplo abaixo.
coluna oculta de e-mail
Nome

Procedimento
Procedimento nº 1 data de vencimento sim
Procedimento nº 2 data de vencimento não

Eu teria várias pessoas na planilha (passando horizontalmente em uma linha) e 'Sim' poderia ser destacado para vários procedimentos atrasados ​​(listados verticalmente na coluna A. Existe uma maneira de criar um código VBA que seja executado para algo assim - se 'Sim' para 'Pessoa 1', então enviar e-mail para 'pessoa 1' com 'procedimento no #' (ou números) e data(s) de vencimento, podendo listar no e-mail todos os procedimentos e suas datas de vencimento posteriores.

Eu não me importaria se tivesse que definir um código VBA separado para cada pessoa, desde que enviasse um e-mail de todos os documentos vencidos para essa pessoa e as datas de vencimento.

Esperando que você possa ajudar
Este comentário foi feito pelo moderador no site
Querida Ann,
Por favor, tente o código VBA abaixo. Obrigado pelo seu comentário.

Sub Mail_small_Text_Outlook()
Dim xRg como intervalo
Dim xCell como intervalo
Escurecer eu enquanto
Escurecer xRows por muito tempo
Escurecer xCols por muito tempo
Dim xVal como string
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
On Error Resume Next
Set xRg = Application.InputBox("Selecione o intervalo que contém o valor da célula na qual você enviará e-mails com base:", "Kutools for Excel", Selection.Address, , , , , 8)
Se xRg não for nada, saia do sub
xRows = xRg.Rows.Count
xCols = xRg.Columns.Count
Para I = 1 Para xLinhas
Definir xCell = xRg(I, xCols)
Se xCell.Value = "Sim" Então
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a sua informação: " & vbNewLine & xCell.Offset(0, -1).Text & vbNewLine & xCell.Offset(0, -2).Text
Com xOutMail
.Para = xCell.Offset(0, -4).Texto
.Subject = "enviar por teste de valor de célula"
.Body = xMailBody
.Exiba 'ou use .Enviar
Terminar com
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
Se acabar
Seguinte
End Sub
Este comentário foi feito pelo moderador no site
Cristal,

Isso substitui o seguinte código:

Sub e-mail()

Dim xRg como intervalo

Dim xRgEach como intervalo

Dim xEmail_Subject, xEmail_Send_Form,;etc.
Este comentário foi feito pelo moderador no site
Onde exatamente inserimos esse código?
Este comentário foi feito pelo moderador no site
Dia bom,
Você precisa colocar o código na janela de código da planilha.
Abra a janela Microsoft Visual Basic for Applications, clique duas vezes no nome da planilha no painel esquerdo para abrir o editor de código.
Este comentário foi feito pelo moderador no site
Oi lá,


Atualmente, estou tendo um pequeno problema com a codificação (novo nisso - pode ter mordido mais do que posso mastigar)


Atualmente tenho uma planilha com o seguinte que preciso de ajuda para automatizar e enviar e-mail por falha que estão em nossas propriedades para nosso negócio


Atualmente, preciso de um código que usará os seguintes dados:


1) Um endereço e o problema ( 2 células "gerais" que foram mescladas via ((Na célula D1)) " = =CONCAT(B1," "C1,) "
O endereço em B1 será sempre o mesmo (mais ou menos)
Enquanto C1 estará sempre mudando dependendo da falha na propriedade.


2) Um e-mail a ser enviado pelo mesmo endereço de e-mail, ( posso usar $E$1 ou tenho que usar E1 - E1. por exemplo) ou posso apenas inserir "TheEmailAdress@.co.uk" na linha de código


3) O corpo do email a ser preenchido de forma semelhante ao ponto 1) ...... ((Na célula F1)) " =CONCAT(G1," ",H1)
Estes estarão mudando constantemente, pois representam a empresa (G1) e o que estão fazendo, consertando, citando ect (H1)

4) O gatilho para enviar o e-mail, eu seria o número 7, a planilha é atualizada diariamente (7 dias na semana)
como tal, preciso do gatilho para enviar o e-mail no dia 7, mas não constantemente como no dia 8, 9, 10+ ect. e não antes, como 1-6, isso seria em A4 : A 100+ (como estamos constantemente expandindo


4) Eu usei pequenos trechos de outros usuários que mencionaram usar uma lista para o gatilho para enviar o e-mail, mas não tenho certeza se estava 100% correto, mas precisaria escanear todo o Collum A ... . A4: A100
e se houver 47 células que contenham apenas " 7 ", serão enviados 47 e-mails


Muito obrigado por ler e espero que possa ajudar :)
Este comentário foi feito pelo moderador no site
Caro martin,
Desculpe não pode ajudar com isso.
Você pode postar sua pergunta em nosso fórum: https://www.extendoffice.com/forum.html para obter mais suporte do Excel de nossa equipe técnica.
Obrigado pelo seu comentário.

Atenciosamente,
Cristal
Este comentário foi feito pelo moderador no site
Oi,


E se eu quisesse enviar o e-mail com base na palavra "concluído" adicionada à coluna L?
Este comentário foi feito pelo moderador no site
Caro Jesse,
O código VBA a seguir pode ajudá-lo a resolver o problema. Obrigado pelo seu comentário.

Private Sub Worksheet_Change (ByVal Target As Range)
Se Target.Cells.Count> 1 Then Exit Sub
Se (Not Intersect(Target, Range("L:L")) for Nothing) And (Target.Value = "completed") Then
Ligue para Mail_small_Text_Outlook
Se acabar
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2"
On Error Resume Next
Com xOutMail
.To = "Endereço de e-mail do seu destinatário"
.CC = ""
.BCC = ""
.Subject = "enviar por teste de valor de célula"
.Body = xMailBody
.Exiba 'ou use .Enviar
Terminar com
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
Oi,
Gostaria que o Outlook aparecesse apenas quando os dados que colei no intervalo ("D7:F7") tiverem pelo menos 1 zero ou um espaço em branco.
Eu removi a linha 'If Target.Cells.Count > 1 Then Exit Sub' e agora o Outlook sempre inicia quando colo qualquer grupo de valores nas células D7:F7.

Ajuda.
Este comentário foi feito pelo moderador no site
Prezado Jan,
O script a seguir pode ajudá-lo a resolver o problema. Obrigado pelo seu comentário.

Private Sub Worksheet_Change (ByVal Target As Range)
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
On Error Resume Next
If Target.Address = Range("D7:F7").Address Then
Com Application.WorksheetFunction
If .CountIf(Target, "") > 0 Ou .CountIf(Target, 0) > 0 Then
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
Com xOutMail
.To = "Endereço de e-mail"
.CC = ""
.BCC = ""
.Subject = "enviar por teste de valor de célula"
.Body = "Olá"
.Exiba 'ou use .Enviar
Terminar com
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
Se acabar
Terminar com
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Então eu usei sua edição para incluir um intervalo de células, mas (se estivermos usando o exemplo da planilha) eu queria saber como adicionar o tipo de fruta, a data e a quantidade no email HTML da planilha se eles se encaixam nos critérios para ter um e-mail gerado. Assim diria

"Olá,"

Nome da fruta da célula "Precisa ser colocado em pedido pendente porque na data do pedido: " data do pedido da célula "temos esta quantidade:" quantidade da célula.
Este comentário foi feito pelo moderador no site
Olá Noemi,
Por favor, tente este script VBA.

Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRg como intervalo
Dim I, J, K Enquanto
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
On Error Resume Next
If Target.Address = Range("D7").Address Then
Com Application.WorksheetFunction
If IsNumeric(Target.Value) e Target.Value > 200 Then
Set xRg = Application.InputBox("Selecione o intervalo de células que você exibirá no corpo da mensagem:", "KuTools for Excel", Selection.Address, , , , , 8)
Se xRg não for nada, saia do sub
Para I = 1 Para xRg.Rows.Count
Para J = 1 Para xRg.Linhas(I).Colunas.Contagem
Para K = 1 Para xRg.Linhas(I).Colunas(J).Contagem
xMailBody = xMailBody & " " & xRg.Rows(I).Columns(J).Cells(K).Text
Seguinte
Seguinte
xMailBody = xMailBody & vbNewLine
Seguinte
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
Com xOutMail
.To = "Endereço de e-mail"
.CC = ""
.BCC = ""
.Subject = "enviar por teste de valor de célula"
.Body = "Olá" & vbNewLine & xMailBody
.Exiba 'ou use .Enviar
Terminar com
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
Se acabar
Terminar com
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
oi cristal
obrigado por seus códigos, se possível, envie os códigos para os detalhes abaixo fornecidos

se tivermos de 8 a 9 cores usando diferentes tipos de expiração, como data de validade do passaporte, data de validade da carteira de motorista, data de validade do registro do veículo, data de validade do passe de portão e muito mais, e o alerta por correio deve ser enviado para apenas 5 pessoas.

como nossa folha de data está com mais de 300 funcionários, vencimento e prazo de validade com em 15 dias na cor vermelha e alerta por e-mail deve ser enviado.

gentilmente faça o necessário

desde já, obrigado
Este comentário foi feito pelo moderador no site
Olá,
Publicamos um artigo "Como enviar e-mail se a data de vencimento foi cumprida no Excel?"
Você pode ver se há respostas neste artigo. Por favor, siga este link para abrir o artigo: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
Obrigado.
Este comentário foi feito pelo moderador no site
Olá- Se eu quisesse enviar para um e-mail de uma lista em vez de colocar um e-mail real no código, isso é possível? obrigado
Este comentário foi feito pelo moderador no site
Olá,
Por favor, tente abaixo do código VBA, quando a célula especificada atender à condição, uma caixa de diálogo será exibida, selecione a célula que contém o endereço de e-mail para o qual você enviará o e-mail. Espero que possa ajudar. Obrigada.

Private Sub Worksheet_Change (ByVal Target As Range)
Se Target.Cells.Count> 1 Then Exit Sub
Definir xRg = intervalo ("D7")
Se xRg = Alvo e Alvo.Valor > 200 Então
Ligue para Mail_small_Text_Outlook
Se acabar
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Dim xRgMsg como intervalo
Dim xCell como intervalo
Set xRgMsg = Application.InputBox("Selecione as células de endereço:", "Kutools for Excel", , , , , , 8)
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2"
On Error Resume Next
Para cada xCell em xRgMsg
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
Com xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Subject = "enviar por teste de valor de célula"
.Body = xMailBody
.Exiba 'ou use .Enviar
Terminar com
xOutApp = Nada
xOutMail = Nada
Seguinte
Em erro GoTo 0
End Sub
Não há comentários postados aqui ainda
carregar mais

Siga-nos

Copyright © 2009 - www.extendoffice.com. | Todos os direitos reservados. Distribuído por ExtendOffice. | | | Mapa do site
Microsoft e o logotipo do Office são marcas comerciais ou marcas registradas da Microsoft Corporation nos Estados Unidos e / ou em outros países.
Protegido por Sectigo SSL