Oi pessoal.
Vou mostrar uma macro para enviar suas planilhas por email diretamente pelo Excel. Então você poderia me dizer: “Ah!!! Mas o Excel já me permite fazer isso através do menu Arquivo > Enviar para…“. E eu lhe digo: “Com toda razão, meu caro!”. Mas diga-me, se por um acaso, você desejasse enviar apenas uma planilha da sua pasta de trabalho, o que você faria? Copiaria essa planilha em um novo arquivo, salvaria este novo arquivo, para só depois enviá-lo. Estou certo?! Então. Esse é só um dos casos que esta macro lhe ajudaria.
Essa rotina que irei descrever pode ser adaptada para diversas situações. Você, como programador, entenderá o seu funcionamento e saberá ajustá-la para a sua necessidade, de acordo com o seu projeto. Seja para enviar automaticamente ao concluir alguma etapa do seu programa, seja para enviar planilhas seletivamente, para enviar para destinatários já cadastrados em algum banco de dados, enfim, use sua criatividade e obtenha os mais fantásticos resultados.
Primeiro, crie um módulo global para escrever a rotina de envio de emails. Vamos chamá-la de EnviarEmail.
Sub EnviarEmail() ActiveWorkbook.SendMail "email_do_destinatário@email.com", "Título do Email" End Sub
O código acima dispensa maiores explicações. Ele serve para enviar todo o arquivo (pasta de trabalho) por email.
A partir dele você pode começar a se divertir, adicionando modificações que atenderão ao seu projeto, em particular. Suponha que sua necessidade seja de enviar apenas uma planilha específica dentre as inúmeras planilhas que você possui no seu arquivo. Você pode fazer assim:
Sub EnviarEmailPlanilhaEspecifica() Dim NovoArquivoXLS As Workbook Dim sPlanAEnviar As String Dim sExcluirAnexoTemporario As String 'Define a planilha que será enviada por email. Ex.: Plan1, Balancete, Lista De Nomes, etc sPlanAEnviar = "Plan2" 'Cria um novo arquivo excel Set NovoArquivoXLS = Application.Workbooks.Add 'Copia a planilha para o novo arquivo criado Sheets(sPlanAEnviar).Copy Before:=NovoArquivoXLS.Sheets(1) 'Salva o arquivo NovoArquivoXLS.SaveAs ThisWorkbook.Path & "" & sPlanAEnviar & ".xls" sExcluirAnexoTemporario = NovoArquivoXLS.FullName 'Envia o email NovoArquivoXLS.SendMail "email_do_destinatário@email.com", "Título do Email" 'Fecha o arquivo novo NovoArquivoXLS.Close 'Exclui o arquivo criado apenas para ser enviado. Kill sExcluirAnexoTemporario End Sub
Esta macro salvará em um novo arquivo excel somente a planilha informada e a enviará por email.
Espero que gostem.
Abraços.
Você também gostará de ler:
Show
Como faço para criar uma fx que me busque os valores da seguite forma:
Na Plan1 tenho vária colunas e em cada uma dela tem um código. e no final a descirção.
Coluna A1 = 101 – C1 = 102 – F = 103 – H1 = Lápis
Já na plan2 na coluna A1 vou digitar 102 e quero que venha a descrição.
Sei que tem exixte o procv mas as formulas ficaria muito grante tem como fazer uma função
que fizesse isso, eu tente mais não consegui.
Obrigado
Reply
Reinaldo Coral Reply:
maio 28th, 2010 at 13:01
Cara, pelo que entendi, você quer pesquisar tendo mais de uma coluna para pesquisar…
PROCV é o mais indicado, existem outras maneiras também, cada uma depende da forma que deseja obter os resultados.
Ou seja, cada caso é um caso.
Não sei bem o que você quer. Mas acho que seria caso de PROCV mesmo. É uma solução mais geral.
Abraço.
Reply
Muito Boa essa dica.
Tem como incrementar após o envio a exclusão do arquivo? Só da plan nova que ele criou.
Tú é muito inteligente
Reply
Reinaldo Coral Reply:
maio 28th, 2010 at 12:51
Gladson, você pode fazer assim:
Adicione uma variável do tipo string para armazenar o endereço do arquivo gerado dinamicamente:
Dim sExcluirAnexoTemporario As String
Em seguida, após a instrução para salvar este arquivo (NovoArquivoXLS.SaveAs …) atribua o path do arquivo à variável criada:
sExcluirAnexoTemporario = NovoArquivoXLS.FullName
Finalmente, após fechar o arquivo do anexo (NovoArquivoXLS.Close), escreva a instrução para excluí-lo:
Kill sExcluirAnexoTemporario
Vou atualizar o código do artigo com esta instrução, ok!
Abraço.
Reply
Deu tudo certo aqui, só falta uma coisa:
Como faço para colocar um texto padrão no corpo de todos os emais que eu for enviar
ex:
Boa tarde,
Seguem dados bla bla bla
Reply
Reinaldo Coral Reply:
junho 27th, 2010 at 11:22
Gabriel,
O método SendMail não fornece suporte a esta funcionalidade.
Você conseguirá isto usando chamadas as dll’s do MAPI ou CDO. Assim que eu tiver uma oportunidade, escreverei algo bem interessante sobre este assunto, ok.
Abrç
Reply
Olá,
Tem como eu mandar por email apenas uma linha (com mais uma célula) da planilha?
Obrigada.
Reply
Reinaldo Coral Reply:
julho 2nd, 2010 at 17:29
Tereza, esta função é específica para enviar arquivos, ou seja, planilhas.
Se você quiser enviar apenas um linha da planilha, deverá enviá-la através de uma planilha contendo apenas a linha que deseja.
Veja. No exemplo do artigo, é criado um novo arquivo apenas com a planilha que deseja enviar. Numa adaptação para o seu caso, a clonagem desta planilha seria substituída apenas pela clonagem da linha desejada, entendeu?
Exemplo: Altera a linha 13 do código por estas abaixo.
Selection.Copy
NovoArquivoXLS.Sheets(1).Range(“A1″).Paste
Application.CutCopyMode = False
Pronto. Sempre que você chamar a função para Enviar, ANTES disso, SELECIONE o intervalo de células que deseja clonar e enviar por email.
Será feita uma cópia deste intervalo em um novo arquivo e enviado por email.
Espero que ajude.
Abraço.
Reply
Deividi Reply:
agosto 19th, 2010 at 10:55
Olá amigo, demorei mas achei alguem competente para me salvar com essas macros !! ( rsss ) mas o problema que encontrei foi o seguinte: por motimo que deconheço, não está colando !!!! está dando erro !!! quando eu chamo para enviar o e-mail, aparece “erro de tempo na execução ’438′ O objeto não aceita esta propriedade ou método.” ae eu vou em depurar, no depurador aparece a linha ” NovoArquivoXLS.Sheets(1).Range(“A1″).Paste ” em destaque, suponho que o erro esteja ae !!! favor me ajudar, sei q o post é antigo… mas se puder… Obrigado >>> segue o código inteiro que estou fazendo o teste >>>
Sub Retângulo6_Clique()
Dim NovoArquivoXLS As Workbook
Dim sPlanAEnviar As String
Dim sExcluirAnexoTemporario As String
sPlanAEnviar = “Plan1″
Set NovoArquivoXLS = Application.Workbooks.Add
Selection.Copy
NovoArquivoXLS.Sheets(1).Range(“A1″).Paste
Application.CutCopyMode = False
NovoArquivoXLS.SaveAs ThisWorkbook.Path & “” & sPlanAEnviar & “.xls”
sExcluirAnexoTemporario = NovoArquivoXLS.FullName
NovoArquivoXLS.SendMail “email_do_destinatário@email.com”, “Lançar OP”
NovoArquivoXLS.Close
Kill sExcluirAnexoTemporario
End Sub
Reply
Reinaldo Coral Reply:
agosto 22nd, 2010 at 13:35
Reescrevendo seu código:
Dim NovoArquivoXLS As Workbook
Dim sPlanAEnviar As String
Dim sExcluirAnexoTemporario As String
Dim wbVoltar As String
sPlanAEnviar = “Plan1″
wbVoltar = ThisWorkbook.Name
Selection.Copy
Set NovoArquivoXLS = Application.Workbooks.Add
Windows(NovoArquivoXLS.Name).Activate
ActiveSheet.Paste Destination:=Worksheets(1).Range(“A1″)
Application.CutCopyMode = False
Windows(wbVoltar).Activate
NovoArquivoXLS.SaveAs ThisWorkbook.Path & “” & sPlanAEnviar & “.xls”
sExcluirAnexoTemporario = NovoArquivoXLS.FullName
NovoArquivoXLS.SendMail “email_do_destinatário@email.com”, “Lançar OP”
NovoArquivoXLS.Close
Kill sExcluirAnexoTemporario
Abç
Ola tudo bom,
Entao sou iniciante em programação, eu copie a macro e ok deu tudo certo. No entando gostaria de colacar um texto no escopo do e-mail do tipo: “boa tarde, segue a planilha em anexo”.
Poderia me ajudar.
Reply
Olha só, eu tenho essa macro que copiei para envio de email, no entanto no escopo do email (message, aparece tambem um texto: “O documento anexado possui uma lista de circulação. Ao terminar de revisá-lo, escolha Próximo Destinatário da Lista de Circulação no menu Enviar para do menu Arquivo do Microsoft Office Excel para retornar o documento ao remetente”. Como faço para tirar essa mensagem
Sub RouteActiveWorkbook()
With ActiveWorkbook
With .RoutingSlip
.Delivery = xlAllAtOnce ‘codigo que permite enviar todos de uma só vez
.Recipients = Array(“andref@xxxxx.com.br”, _
“adailton@xxxxxx.com.br”, “joao@xxxxx.com.br”)
.Subject = “teste”
.Message = “TESTE DE E-MAIL AUTOMÁTICO”
End With
.Route
End With
End Sub
Reply