Enviar E-mail por Excel

[Eloize Teixeira 9]

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 202]

Olá,

 

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

 

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

Editado 13 de outubro de 2015 por Wendell Menezes

[Eloize Teixeira Autor do tópico 9]

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 202]

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 Autor do tópico 9]

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 202]

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 Autor do tópico 9]

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 202]

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 Autor do tópico 9]

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 202]

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.

[Eloize Teixeira Autor do tópico 9]

Vou enviar a planilha. poderia verificar pra moim ?!

me passa seu email, pois nao posso deixar publico. att