Ir para o conteúdo principal
Note: The other languages of the website are Google-translated. Back to English

Como enviar e-mail se a data de vencimento foi cumprida no Excel?

Conforme mostrado na captura de tela abaixo, se a data de vencimento na coluna C for menor ou igual a 7 dias (por exemplo, a data atual é 2017/9/13), um e-mail será enviado ao destinatário especificado na coluna A e o o conteúdo especificado na coluna B é exibido no corpo do e-mail. Como você poderia fazer para alcançá-lo? Este artigo fornece um código VBA para ajudá-lo a realizar essa tarefa.

Envie um e-mail se a data de vencimento for cumprida com o código VBA


Envie um e-mail se a data de vencimento for cumprida com o código VBA

Faça o seguinte para enviar um lembrete por e-mail caso a data de vencimento tenha sido cumprida no Excel.

1. aperte o outro + F11 simultaneamente para abrir o Microsoft Visual Basic para Aplicações janela.

2. No Microsoft Visual Basic para Aplicações janela, por favor clique inserção > Módulo. Em seguida, copie e cole o código VBA abaixo na janela Módulo.

Código VBA: enviar e-mail se a data de vencimento estiver fechada no Excel

Public Sub CheckAndSendMail()
'Updated by Extendoffice 2018/11/22
    Dim xRgDate As Range
    Dim xRgSend As Range
    Dim xRgText As Range
    Dim xRgDone As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xLastRow As Long
    Dim vbCrLf As String
    Dim xMailBody As String
    Dim xRgDateVal As String
    Dim xRgSendVal As String
    Dim xMailSubject As String
    Dim i As Long
    On Error Resume Next
    Set xRgDate = Application.InputBox("Please select the due date column:", "KuTools For Excel", , , , , , 8)
    If xRgDate Is Nothing Then Exit Sub
    Set xRgSend = Application.InputBox("Please select the recipients?email column:", "KuTools For Excel", , , , , , 8)
    If xRgSend Is Nothing Then Exit Sub
    Set xRgText = Application.InputBox("Select the column with reminded content in your email:", "KuTools For Excel", , , , , , 8)
    If xRgText Is Nothing Then Exit Sub
    xLastRow = xRgDate.Rows.count
    Set xRgDate = xRgDate(1)
    Set xRgSend = xRgSend(1)
    Set xRgText = xRgText(1)
    Set xOutApp = CreateObject("Outlook.Application")
    For i = 1 To xLastRow
        xRgDateVal = ""
        xRgDateVal = xRgDate.Offset(i - 1).Value
        If xRgDateVal <> "" Then
        If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
            xRgSendVal = xRgSend.Offset(i - 1).Value
            xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
            vbCrLf = "<br><br>"
            xMailBody = "<HTML><BODY>"
            xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
            xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
            xMailBody = xMailBody & "</BODY></HTML>"
            Set xMailItem = xOutApp.CreateItem(0)
            With xMailItem
                .Subject = xMailSubject
                .To = xRgSendVal
                .HTMLBody = xMailBody
                .Display
                '.Send
            End With
            Set xMailItem = Nothing
        End If
    End If
    Next
    Set xOutApp = Nothing
End Sub

Notas: A linha Se CDate (xRgDateVal) - Data <= 7 E CDate (xRgDateVal) - Data> 0 Então, no código VBA, significa que a data de vencimento deve ser maior que 1 dia e menor ou igual a 7 dias. Você pode alterá-lo conforme necessário.

3. Pressione do Tecla F5 para executar o código. Na primeira aparição Kutools for Excel caixa de diálogo, selecione o intervalo da coluna de data de vencimento e clique no botão OK botão. Veja a imagem:

4. Então o segundo Kutools for Excel caixa de diálogo aparece, selecione o intervalo de coluna correspondente que contém os endereços de e-mail dos destinatários e clique no botão OK botão. Veja a imagem:

5. No último Kutools for Excel caixa de diálogo, selecione o conteúdo que deseja exibir no corpo do e-mail e clique no OK botão.

Em seguida, um e-mail será criado automaticamente com o destinatário, assunto e corpo especificados listados se a data de vencimento na coluna C for menor ou igual a 7 dias. Por favor clique no ENVIAR botão para enviar o e-mail.

Notas:

1. Cada e-mail criado corresponde a uma data de vencimento. Por exemplo, se houver três datas de vencimento que atendam aos critérios, três mensagens de e-mail serão criadas automaticamente.

2. Este código não será acionado se não houver datas que atendam aos critérios.

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


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

Office Tab Traz a 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 (124)
Avaliado 4.5 fora do 5 · classificações 1
Este comentário foi feito pelo moderador no site
Obrigado por compartilhar.


Como você adicionaria entradas Cc ou vários destinatários?
Este comentário foi feito pelo moderador no site
Oi Brandon,

Desculpe comentar sua postagem sem uma resposta, mas você conseguiu obter o código VBA para enviar um e-mail?
Este comentário foi feito pelo moderador no site
Eu usei seu código VBA para enviar e-mails com base em um valor de célula, mas não funciona.
Tudo até a etapa 5 funciona, mas nenhum e-mail é enviado. Alguém pode me ajudar com isso?
Este comentário foi feito pelo moderador no site
Me viene muy bien gracias por el aporte, solo me falta como puedo hacerlo automaticamente sem necesidad de hacerlo manualmente el envio del correo.
Este comentário foi feito pelo moderador no site
Este código congelou meu programa Excel quando o executei. É intensivo de memória?
Este comentário foi feito pelo moderador no site
Oi Robert,
O problema que você mencionou não aparece no meu caso. Posso ter sua versão do Office?
Este comentário foi feito pelo moderador no site
podemos apenas inserir os detalhes uma vez e os e-mails podem ser enviados automaticamente, em vez de sempre precisar selecionar as colunas?
Este comentário foi feito pelo moderador no site
Olá Diya,
Se você não quiser selecionar manualmente as colunas, aplique o código VBA abaixo.
Nota: Você só precisa selecionar a coluna de datas de vencimento após aplicar o código.

Public Sub CheckAndSendMail()
'Atualizado por Extendoffice 2017/9/14
Dim xRgDate como intervalo
Dim xRgSend As Range
Dim xRgText como intervalo
Dim xRgDone As Range
Dim xOutApp como objeto
Dim xMailItem como objeto
Dim xLastRow Tão Longo
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal como string
Dim xRgSendVal As String
Dim xMailSubject As String
Escurecer eu enquanto
On Error Resume Next
Set xRgDate = Application.InputBox("Por favor, selecione a coluna da data de vencimento:", "KuTools For Excel", , , , , , 8)
Se xRgDate não for nada, saia do sub
xLastRow = xRgDate.Rows.Count
Definir xRgDate = xRgDate(1)
Definir xRgSend = xRgSend(1)
Definir xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
Para I = 1 Para xLastRow
xRgDateVal = xRgDate.Offset(I - 1).Value
If CDate(xRgDateVal) - Data <= 7 E CDate(xRgDateVal) - Data > 0 Then
xRgSendVal = xRgSend.Offset(I - 1).Value
xMailSubject = xRgText.Offset(I - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = "Olá" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2"
Definir xMailItem = xOutApp.CreateItem(0)
Com xMailItem
.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
Definir xMailItem = Nada
Se acabar
Próximo
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
Olá,
Eu também sou um iniciante e gostaria de fazer outra pergunta para o seu grande Sub.

Como posso enviar um e-mail somente se um determinado endereço de e-mail estiver na célula referente?

Eu preciso disso, porque na minha ferramenta excel eu implementei alguns botões para cada pessoa, que precisa de um lembrete.

Muito obrigado antecipadamente!!

Thomas
Este comentário foi feito pelo moderador no site
Oi Thomas,
Publicamos um artigo "Como enviar e-mail para endereços de e-mail especificados em células no Excel?"
https://www.extendoffice.com/documents/excel/4717-excel-macro-send-email-to-address-in-cells.html
Talvez você possa encontrar sua solução neste artigo.
Este comentário foi feito pelo moderador no site
Eu preciso que isso funcione em todas as planilhas em uma pasta de trabalho, a data futura será inserida manualmente na mesma célula em todas as planilhas e novas planilhas serão criadas diariamente. Também preciso do nome da planilha no e-mail para saber qual planilha está vencida
Este comentário foi feito pelo moderador no site
Desculpe não pode ajudá-lo com isso.
Bem-vindo a postar qualquer pergunta sobre o Excel em nosso fórum: https://www.extendoffice.com/forum.html. Você obterá mais suportes do Excel de nossos profissionais ou outros fãs do Excel.
Este comentário foi feito pelo moderador no site
Não faça funcionar. Usando o Office 365 para que o Outlook e o Excel sejam rígidos o suficiente. Como no post de "schou" 4 meses atrás, funciona até a etapa 5, mas nada.
Uma solução para isso?
Este comentário foi feito pelo moderador no site
Eu tenho o Excel para enviar o e-mail, mas posso definir isso para que ele envie um e-mail toda vez que eu abro o Excel em vez de selecionar as colunas a cada vez.

Eu tenho uma pasta de trabalho com 24 páginas, então estou procurando enviar e-mail automaticamente quando a pasta de trabalho é aberta.


Muito obrigado.
Este comentário foi feito pelo moderador no site
Oi,
Você quer dizer verificar a data de vencimento automaticamente na pasta de trabalho e enviar e-mail quando a pasta de trabalho for aberta?
Este comentário foi feito pelo moderador no site
Oi pessoal,


Macro é ótimo, mas eu gostaria de perguntar uma coisa - se você tem alguém na lista sem nenhuma data como modificar o código vba para excluir esse cara? Agora o código gera e-mails até para os caras sem data.


Obrigado!
Este comentário foi feito pelo moderador no site
Olá Lvan,
O código foi atualizado com a solução do problema, por favor, tente. Obrigado pelo seu comentário.
Este comentário foi feito pelo moderador no site
Oi, Mail está gerando automaticamente para colunas com dados vazios. Eu também gostaria de ter o código atualizado.
Este comentário foi feito pelo moderador no site
Muito obrigado pela contribuição. Gostaria de saber como usar a seleção de coluna fixa sem precisar usar kutools? ou seja, deixar colunas padrão de datas, recibos e avisos?
Este comentário foi feito pelo moderador no site
Dia bom,
O código VBA abaixo pode ajudá-lo. Por favor, tente.

Public Sub CheckAndSendMail()
'Atualizado por Extendoffice 2018/11/22
Dim xRgDate como intervalo
Dim xRgSend As Range
Dim xRgText como intervalo
Dim xRgDone As Range
Dim xOutApp como objeto
Dim xMailItem como objeto
Dim xLastRow Tão Longo
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal como string
Dim xRgSendVal As String
Dim xMailSubject As String
Dim i tanto tempo
On Error Resume Next
Set xRgDate = Range("C2:C4") 'Por favor, consulte a coluna de data de vencimento
Se xRgDate não for nada, saia do sub
Set xRgSend = Range("A2:A4") 'Por favor, refira os destinatários?coluna de e-mail
Se xRgSend não for nada, saia do sub
Set xRgText = Range("B2:B4") Insira a coluna com o conteúdo lembrado em seu e-mail
Se xRgText não for nada, saia do sub
xLastRow = xRgDate.Rows.count
Definir xRgDate = xRgDate(1)
Definir xRgSend = xRgSend(1)
Definir xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
Para i = 1 Para xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
Se xRgDateVal <> "" Então
If CDate(xRgDateVal) - Data <= 7 E CDate(xRgDateVal) - Data > 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = ""
xMailBody = xMailBody & "Caro " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Texto: " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Definir xMailItem = xOutApp.CreateItem(0)
Com xMailItem
.Assunto = xMailAssunto
.Para = xRgSendVal
.HTMLBody = xMailBody
.Exibição
'.Mandar
Terminar com
Definir xMailItem = Nada
Se acabar
Se acabar
Próximo
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
Prezado Cristal,

Obrigado pela sua partilha.

Sou iniciante e tenho um problema com código.

xMailBody = ""
xMailBody = xMailBody & "Caro " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Texto: " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""

O texto não vai para uma nova linha.
Poderia ajudar por favor.

obrigado
Este comentário foi feito pelo moderador no site
Ni niti,
Você precisa adicionar a linha vbCrLf = " " diante dos resfriados.
Tal como:
vbCrLf = " "
xMailBody = ""
xMailBody = xMailBody & "Caro " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Texto: " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Este comentário foi feito pelo moderador no site
Caro Crystal, Ao selecionar a coluna de datas, várias células em colunas diferentes podem ser selecionadas?
Este comentário foi feito pelo moderador no site
Olá,
Sr. Crystal, em sua última conversa com o Sr. Ivan, ele pediu o código para enviar e-mail toda vez que a planilha for aberta ao invés de digitar os códigos toda vez.
Eu preciso do mesmo código, mesma situação, você pode ajudar por favor?
Este comentário foi feito pelo moderador no site
Corretamente, não foi com o Sr. Ivan, mas com o Sr. Austin.
Obrigado.
Este comentário foi feito pelo moderador no site
Oi, estou usando uma versão modificada deste código e sou bastante novo no VBA. Fiquei curioso se havia a possibilidade de quando o e-mail fosse enviado, que a macro pudesse marcar um X, ou se alguém tivesse Completo, que um e-mail não fosse enviado. Espero que isso tudo faça sentido. Qualquer ajuda é muito apreciada.

Pouco fundo, estou usando esta ferramenta para executar uma verificação de data de vencimento em 30 dias, 60 dias e em atraso. Quero que 1 e-mail seja enviado em 30 dias, 1 em 60 dias e, em seguida, atrasado também. Estou executando isso a partir de um script VB que escrevi, para poder automatizá-lo diariamente. Obrigado!
Este comentário foi feito pelo moderador no site
Oi, estou usando uma versão modificada deste código e sou bastante novo no VBA. Fiquei curioso se havia a possibilidade de quando o e-mail fosse enviado, que a macro pudesse marcar um X, ou se alguém tivesse Completo, que um e-mail não fosse enviado. Espero que isso tudo faça sentido. Qualquer ajuda é muito apreciada. Pouco fundo, estou usando esta ferramenta para executar uma verificação de data de vencimento em 30 dias, 60 dias e em atraso. Quero que 1 e-mail seja enviado em 30 dias, 1 em 60 dias e, em seguida, atrasado também. Estou executando isso a partir de um script VB que escrevi, para poder automatizá-lo diariamente. Obrigado!
Este comentário foi feito pelo moderador no site
Olá Senhor,

Isso é muito útil. Preciso de mais 2 aprimoramentos nos mesmos códigos. Eu tenho que clicar no botão enviar toda vez, tudo bem desde que eu tenha 10 e-mails para serem enviados, e se eu >25 e-mails para serem enviados em um único dia. Então, por favor, me dê um código para enviar e-mail automaticamente ao selecionar Data de vencimento, Destinatário, Assunto etc.

Além disso, forneça-me o código para adicionar a opção "CC" também


obrigado

Sonda P
Este comentário foi feito pelo moderador no site
Dia bom,
Por favor, tente o código VBA abaixo, espero poder ajudar. Obrigado por comentar.

Public Sub CheckAndSendMail()
'Atualizado por Extendoffice 2018/11/22
Dim xRgDate como intervalo
Dim xRgSend As Range
Dim xRgText como intervalo
Dim xRgDone As Range
Dim xOutApp como objeto
Dim xMailItem como objeto
Dim xLastRow Tão Longo
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal como string
Dim xRgSendVal As String
Dim xMailSubject As String
Dim i tanto tempo
On Error Resume Next
Set xRgDate = Application.InputBox("Por favor, selecione a coluna da data de vencimento:", "KuTools For Excel", , , , , , 8)
Se xRgDate não for nada, saia do sub
Set xRgSend = Application.InputBox("Selecione os destinatários? coluna de e-mail:", "KuTools For Excel", , , , , , 8)
Se xRgSend não for nada, saia do sub
Set xRgCC = Application.InputBox("Selecione os destinatários CC?coluna de e-mail:", "KuTools For Excel", , , , , , 8)
Se xRgCC não for nada, saia do sub
Set xRgText = Application.InputBox("Selecione a coluna com conteúdo lembrado em seu e-mail:", "KuTools For Excel", , , , , , 8)
Se xRgText não for nada, saia do sub
xLastRow = xRgDate.Rows.Count
Definir xRgDate = xRgDate(1)
Definir xRgSend = xRgSend(1)
Definir xRgCC = xRgCC(1)
Definir xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
Para i = 1 Para xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
Se xRgDateVal <> "" Então
If CDate(xRgDateVal) - Data <= 7 E CDate(xRgDateVal) - Data > 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xRgCCVal = xRgCC.Offset(i - 1).Valor
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = ""
xMailBody = xMailBody & "Caro " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Texto: " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Definir xMailItem = xOutApp.CreateItem(0)
Com xMailItem
.Assunto = xMailAssunto
.Para = xRgSendVal
.Cc = xRgCCVal
.HTMLBody = xMailBody
.Mandar
Terminar com
Definir xMailItem = Nada
Se acabar
Se acabar
Próximo
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
Olá Cristal,

Obrigado pelos códigos, pois são muito úteis. Mas como fazer o código funcionar se estou usando o outlook.office.com?
Este comentário foi feito pelo moderador no site
no corpo eu quero o valor da coluna a,b,c em um formato de tabela, como a data de expiração uma vez alcançada na coluna do corpo eu quero imprimir os detalhes das células a,b,c em formato de tabela
Este comentário foi feito pelo moderador no site
Olá Dinesh BS,
Desculpe não poder ajudá-lo com isso. Bem-vindo a postar qualquer pergunta em nosso fórum: https://www.extendoffice.com/forum.html.
Este comentário foi feito pelo moderador no site
Olá, sou novo em VBA. Existe uma maneira de fazer com que este programa seja executado automaticamente sempre que o arquivo for aberto?
Este comentário foi feito pelo moderador no site
Olá L Echols,
Para executar o código automaticamente quando o arquivo for aberto, clique duas vezes para abrir a janela de código ThisWorkbook (localizada no lado esquerdo da janela Microsoft Visual Basic for Applications), selecione Workbook na primeira lista suspensa e copie o acima do código VBA (exceto a primeira e a última linha) na janela de código e cole entre as duas linhas fornecidas. Veja a captura de tela anexada abaixo:
Este comentário foi feito pelo moderador no site
Isso é incrível. Eu queria saber se existe uma maneira de executar o código sem ter que selecionar o KuTools valores sempre? Para esclarecimento, inseri este código e agora, sempre que abro a pasta de trabalho, ainda preciso destacar as mesmas colunas. Existe uma maneira de inserir o código para executar uma verificação nas mesmas colunas todas as vezes - desde que nenhuma edição na pasta de trabalho tenha sido feita - para executar a verificação e formular um e-mail com base na referida verificação? Agradeço antecipadamente.
Este comentário foi feito pelo moderador no site
Oi Danny
Por favor, tente o código abaixo e altere os intervalos conforme necessário.

Public Sub CheckAndSendMail()
'Atualizado por Extendoffice 2019/5/17
Dim xRgDate como intervalo
Dim xRgSend As Range
Dim xRgText como intervalo
Dim xRgDone As Range
Dim xOutApp como objeto
Dim xMailItem como objeto
Dim xLastRow Tão Longo
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal como string
Dim xRgSendVal As String
Dim xMailSubject As String
Dim i tanto tempo
On Error Resume Next
Definir xRgDate = Range("C2: C4")
Se xRgDate não for nada, saia do sub
Definir xRgSend = Range("A2: A4")
Se xRgSend não for nada, saia do sub
Set xRgText = Range("B2:B4")
Se xRgText não for nada, saia do sub
xLastRow = xRgDate.Rows.Count
Definir xRgDate = xRgDate(1)
Definir xRgSend = xRgSend(1)
Definir xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
Para i = 1 Para xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
Se xRgDateVal <> "" Então
If CDate(xRgDateVal) - Data <= 7 E CDate(xRgDateVal) - Data > 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = ""
xMailBody = xMailBody & "Caro " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Texto: " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Definir xMailItem = xOutApp.CreateItem(0)
Com xMailItem
.Assunto = xMailAssunto
.Para = xRgSendVal
.HTMLBody = xMailBody
.Exibição
'.Mandar
Terminar com
Definir xMailItem = Nada
Se acabar
Se acabar
Próximo
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
Isso é incrível. Eu queria saber se existe uma maneira de executar o código sem ter que selecionar o KuTools valores sempre? Para esclarecimento, inseri este código e agora, sempre que abro a pasta de trabalho, ainda preciso destacar as mesmas colunas. Existe uma maneira de inserir o código para executar uma verificação nas mesmas colunas todas as vezes - desde que nenhuma edição na pasta de trabalho tenha sido feita - para executar a verificação e formular um e-mail com base na referida verificação? Agradeço antecipadamente.
Este comentário foi feito pelo moderador no site
Olá Cristal,
Estou tendo um problema com o envio automático de e-mail quando o arquivo é aberto. Por exemplo, tenho todas as informações de data de vencimento na Plan1. No entanto, se eu salvar e fechar o arquivo quando estava trabalhando na Plan2, assim que abrir o arquivo, os valores para enviar emails serão baseados na Plan2 e não na Plan1. Eu só tenho módulo adicionado em Sheet1 e ThisWorkbook. Acho que ter o mesmo vba no ThisWorkbook dispara para enviar e-mails automáticos em qualquer planilha que eu tenha aberto no momento. Como posso restringir o VBA para extrair valor de uma planilha específica e também enviar e-mails quando o arquivo é aberto? Muito obrigado pela sua ajuda com antecedência!
Este comentário foi feito pelo moderador no site
Sou novo no VBA. Existe uma maneira de executar automaticamente este programa sempre que o arquivo é aberto?
Este comentário foi feito pelo moderador no site
Sim com


Private Sub Workbook_Open ()
*Entre com o código aqui*
End Sub
Este comentário foi feito pelo moderador no site
Oi,

Eu tenho uma pergunta

Se eu quiser selecionar um intervalo predeterminado de células, como eu poderia modificar o código nesta parte:

xLastRow = xRgDate.Rows.Count
Definir xRgDate = xRgDate(1)

Para definir automaticamente as células?

Obrigado :)
Este comentário foi feito pelo moderador no site
Oi,
Se você não quiser selecionar intervalos manualmente toda vez que aplicar o código, use o código abaixo.

Public Sub CheckAndSendMail()
'Atualizado por Extendoffice 2019/12/10
Dim xRgDate como intervalo
Dim xRgSend As Range
Dim xRgText como intervalo
Dim xRgDone As Range
Dim xOutApp como objeto
Dim xMailItem como objeto
Dim xLastRow Tão Longo
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal como string
Dim xRgSendVal As String
Dim xMailSubject As String
Dim i tanto tempo
On Error Resume Next
Definir xRgDate = Range("C2: C4")
Se xRgDate não for nada, saia do sub
Definir xRgSend = Range("A2: A4")
Se xRgSend não for nada, saia do sub
Set xRgText = Range("B2:B4")
Se xRgText não for nada, saia do sub
xLastRow = xRgDate.Rows.Count
Definir xRgDate = xRgDate(1)
Definir xRgSend = xRgSend(1)
Definir xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
Para i = 1 Para xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
Se xRgDateVal <> "" Então
If CDate(xRgDateVal) - Data <= 7 E CDate(xRgDateVal) - Data > 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = ""
xMailBody = xMailBody & "Caro " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Texto: " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Definir xMailItem = xOutApp.CreateItem(0)
Com xMailItem
.Assunto = xMailAssunto
.Para = xRgSendVal
.HTMLBody = xMailBody
.Exibição
'.Mandar
Terminar com
Definir xMailItem = Nada
Se acabar
Se acabar
Próximo
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
Buenos dias! ¿que modificação tende a realizar para dejar as seleções das células com as informações de data, texto e correo e não tem que selecionar as cada vez que ativar a macro?

también me gustaria saber como introducir un CC, es decir, poder poner a outra persona en copia del correo. Obrigado!
Este comentário foi feito pelo moderador no site
Olá! Pudiste resolver está? Estoy necesitando lo mismo.. gracias!
Não há comentários postados aqui ainda
carregar mais