Enviar E-mail por Excel

Eloize Teixeira · 13 de outubro de 2015

Boa noite pessoal, tudo bom?!

Poderiam me ajudar com uma macro?

Na minha planilha em anexo, preciso atribuir ao botão "Enviar E-mail Salvar Controle", o comando de salvar o que ta escrito em um banco de dados (já está OK), e enviar apenas a aba "4D" anexa para um e-mail x com cópia para 2 emails y que constam na Aba "Regras". O nome do arquivo anexo terá como nome o conteúdo da célula "AQ2" & " - "& "B9" e o assunto do e-mail também,(assunto de acordo com aba "Regras".

No corpo do email tera a mensagem = "Segue CCMS para tratativa .. ", conforme aba "Regras"

Nota: Pelo o que tenho lido nos foruns para enviar um arquivo como anexo tem que salvar ele e depois apaga sozinho.. o caminho pode ser o temp mas programado como ENVIRON, para qlq usuario fazer isso, e o arquivo deve conter o mesmo nome que o assunto e habilitado para macro

Nota2= O botão que envia esse formulário "Enviar E-mail Salvar Controle" não pode aparecer para a pessoa que vai receber o e-mail, mas sim, somente o botao "Salvar em PDF".

Tem como me ajudar? Pleaseeee

Desde já, muito obrigada!

Relatório 4D.xls

Wendell Menezes · 13 de outubro de 2015

Olá,

Veja se consegue adaptar o código desse tópico:

http://forum.clubedohardware.com.br/forums/topic/1133492-vba-enviar-varios-emails-excel/

Eloize Teixeira · 13 de outubro de 2015

Desculpe Wendell, eu sou bem iniciante em macro, na verdade estou aprendendo aos poucos. Achei um pouco complexo para adaptar a minha situação

Wendell Menezes · 14 de outubro de 2015

Macro que salva e gera o e-mail

Sub Save_and_Send()Dim File As String, HTMLBody As StringDim OA As Object, OM As ObjectWith Sheets("4D")    File = Environ("USERPROFILE") & "\Desktop\" & .Range("AQ2") & " - " & .Range("B9") & ".pdf"    HTMLBody = "Bom dia Fulano,<br><br>Em anexo CCMS " & .Range("AQ2") & " para investigação. Prazo para resposta até " & .Range("AC4") & ".<br><br>Atenciosamente,"    Set OA = CreateObject("Outlook.Application")    Set OM = OA.CreateItem(0)    .Range("B2:BB65").ExportAsFixedFormat xlTypePDF, File        With OM            .To = Sheets("Regras").Range("B1").Value            .CC = Sheets("Regras").Range("B2").Value            .Subject = "CCMS: " & Sheets("4D").Range("AQ2") & " - " & Sheets("4D").Range("B9")            .HTMLBody = HTMLBody & "<br>"            .Attachments.Add File            .Display        End WithEnd WithEnd Sub

Eloize Teixeira · 14 de outubro de 2015

Vou adicionar tudo a um botão.

Para isso ocorrer de forma automática, devo colocar o .Send abaixo do .Display ?

With Sheets("4D") =>> Para adicionar nova aba, posso colocar =>> With Sheets("4D") & Sheets("Plan1")
File = Environ("USERPROFILE") & "\Desktop\" & .Range("AQ2") & " - " & .Range("B9") & ".pdf" ==>> Para alterar para xlsm só alterar ".xlsm", porém mais abaixo==>>

.Range("B2:BB65").ExportAsFixedFormat xlTypePDF, File

With OM ==>> teria que alterar certo?>

Wendell Menezes · 15 de outubro de 2015

Se for útil clique em curtir.

Sub Save_and_Send()Dim File As String, HTMLBody As StringDim OA As Object, OM As ObjectDim Sh As WorksheetApplication.DisplayAlerts = FalseWith ThisWorkbook.Sheets("4D")    File = Environ("USERPROFILE") & "\Desktop\" & .Range("AQ2") & " - " & .Range("B9") & ".xlsm"    HTMLBody = "Bom dia Fulano,<br><br>Em anexo CCMS " & .Range("AQ2") & " para investigação. Prazo para resposta até " & .Range("AC4") & ".<br><br>Atenciosamente,"    Set OA = CreateObject("Outlook.Application")    Set OM = OA.CreateItem(0)    Workbooks.Add        For Each Sh In ActiveWorkbook.Worksheets            If Sheets.Count = 1 Then                Sh.Name = " "                    Else                Sh.Delete            End If        Next    ThisWorkbook.Sheets("Plan1").Copy Before:=ActiveWorkbook.Sheets(1)    .Copy Before:=ActiveWorkbook.Sheets(1)    ActiveWorkbook.SaveAs File, 52    ActiveWorkbook.Close        With OM            .To = Sheets("Regras").Range("B1").Value            .CC = Sheets("Regras").Range("B2").Value            .Subject = "CCMS: " & Sheets("4D").Range("AQ2") & " - " & Sheets("4D").Range("B9")            .HTMLBody = HTMLBody & "<br>"            .Attachments.Add File            .Send        End WithEnd WithEnd Sub

Eloize Teixeira · 20 de outubro de 2015

Minha planilha esta funcionando, mas com um porém:

ThisWorkbook.Sheets("Plan1").Copy Before:=ActiveWorkbook.Sheets(1)

Esse Plan1 tem uma macro de gerar PDF, que salva no Desktop de qualquer pessoa. Meu arquivo fica em rede, e a pessoa que recebe essa nova planilha gerada pela macro, não tem acesso a rede, portanto, quando vai gerar um PDF, ele acusa que a pessoa não tem acesso a rede!.. Acredito que esteja pegando vínculos. O que posso fazer para resolver isso ?!

ATT

Wendell Menezes · 20 de outubro de 2015

Esse atenderia?

Sub Save_and_Send()Dim File As String, Module As String, HTMLBody As StringDim OA As Object, OM As ObjectDim Sh As WorksheetApplication.DisplayAlerts = FalseWith ThisWorkbook.Sheets("4D")    File = Environ("USERPROFILE") & "\Desktop\" & .Range("AQ2") & " - " & .Range("B9") & ".xlsm"    Module = Environ("USERPROFILE") & "\Desktop\Script.bas"    HTMLBody = "Bom dia Fulano,<br><br>Em anexo CCMS " & .Range("AQ2") & " para investigação. Prazo para resposta até " & .Range("AC4") & ".<br><br>Atenciosamente,"    Set OA = CreateObject("Outlook.Application")    Set OM = OA.CreateItem(0)    ThisWorkbook.SaveAs File, 52        With OM            .To = Sheets("Regras").Range("B1").Value            .CC = Sheets("Regras").Range("B2").Value            .Subject = "CCMS: " & Sheets("4D").Range("AQ2") & " - " & Sheets("4D").Range("B9")            .HTMLBody = HTMLBody & "<br>"            .Attachments.Add File            .Send        End With    ActiveWorkbook.CloseEnd WithEnd Sub

Eloize Teixeira · 22 de outubro de 2015

Não funcionou, porém fiz o seguinte:

ActiveWorkbook.BreakLink Name:= _

"G:\BRITA-CD_Itapevi\KPI Logistica\CCMS\Controles\Controle Reclamação_ID Logistics_V2.xlsm" _

, Type:=xlExcelLinks

Tirei o vínculo assim, mas ao fazer isso, a macro do botao gerar PDF some, sendo assim, agora o problema é: criar dentro dessa macro, uma macro pro botao 1, algo como adicionar(letra azul)(não sei se está correto):

ActiveWorkbook.BreakLink Name:= _

"G:\BRITA-CD_Itapevi\KPI Logistica\CCMS\Controles\Controle Reclamação_ID Logistics_V2.xlsm" _

, Type:=xlExcelLinks

CommandButton1.Click

nome = Environ("USERPROFILE") & "\Desktop\" & Sheets("Investigação").Range("AQ2") & " - " & Sheets("Investigação").Range("B9") & ".pdf"

ActiveSheet.Range("B2:Bb68").ExportAsFixedFormat Type:=xlTypePDF, Filename:=nome

MsgBox "Verifique sua Área de Trabalho", vbInformation, "Arquivo Salvo com Sucesso!"

Como faço para adicionar a macro de salvar o PDF no CLique do botão 1, já no meio de uma macro(sem abrir outra macro)(Exemplo acima, não sei se está correto)

Ahh, e como fica o Dim no início da fórmula também, se necessário

Wendell Menezes · 22 de outubro de 2015

porque não funcionou? Alguma mensagem de erro?

Não é impossível criar uma macro dentro do arquivo gerado, mas não recomendo essa opção. Pelos aqui no meu computador isso só funciona se eu desabilitar uma das opçãos de segurança do Excel.