Usuário com melhor resposta
Botão enviando parte da planilha a emails

Pergunta
-
Quero criar um "botão " que mandaria a pagina para um grupo de email, porem não pode ser em anexo, o corpo do email seria a planilha, e também com um titulo espenicado na pagina, exemplo ter um campo da pagina aonde editaria que seria o titulo.
Respostas
-
Tente adaptar estes código.
1 - Cria uma planilha e salva como pasta habilitada para macro.
2 - Renomeia a plan2 para "Relatório"
3 - Na plan1 crie uma Lista desta forma; seleciona as células da B4:B50 e click no campo de formula esquerdo dei um entra e escreve "Lista". Esta sera o campo de lista aonde vc vai cadastrar os email a ser enviado.
Agora ALT + F11 depois inserir UserForm1
1 - No UserForm1 click em caixa de ferramenta e inserir os seguintes;
ComboBox1, TextBox1, TextBox2 e CommandButton1
Agora dei dois click sobre o userform apaga as duas linha e cole todo este código.
Private Sub UserForm_Initialize() Me.ComboBox1.List = Application.WorksheetFunction.Transpose(Plan1.Range("B4:B50")) 'AQUI BUSCA OS E-MAIL CADASTRADOS NA PLAN1 End Sub Private Sub CommandButton1_Click() On Error GoTo debugs Application.DisplayAlerts = False Sheets(Array("Relatório")).Copy 'Aqui salva a planilha Relatório. ' Sheets(Array("Relatório", "Plan3")).Copy 'se quiser mais planilha usa esta linha ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & TextBox1 & ".xlsx" 'Aqui o arquivo salvo recebe o nome do TextBox1 ActiveWorkbook.Save ActiveWorkbook.Close Call Enviar_Email 'Aqui chama enviar e-mail End debugs: 'Se de erro em salvar o arquivo exclui o arquivo e emiti mensagem qual o erro MsgBox "ERRO!!!! O E-mail Não Foi Enviado ! ! !", vbOKOnly + vbCritical If Err.Description <> "" Then MsgBox Err.Description, vbInformation, "O E-MAIL NÃO FOI ENVIADO ! ! ! ! ! ! ! !" MsgBox "Provavelmente erro; mudança no nome da aba Relatório, ou sem internet,........." End End Sub Sub Enviar_Email() 'aqui envia o email pelo gmail ou se preferir hotmail 'Label6 = "AGUARDE ENVIANDO......" Application.ScreenUpdating = False Dim oMensagem As Object Dim oConfiguração As Object Dim sCorpo As String Dim vFields As Variant Dim objWS As Object Dim strCaminho As String On Error GoTo debugs Set objWS = CreateObject("WScript.Shell") strCaminho = ThisWorkbook.Path & "\" & TextBox1 & ".xlsx" 'linha em branco Set oMensagem = CreateObject("CDO.Message") Set oConfiguração = CreateObject("CDO.Configuration") oConfiguração.Load -1 'Padrões CDO Set vFields = oConfiguração.Fields With vFields .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 'se conta for hotmail usar este = "smtp.live.com" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 'se for hotmail usar este = 25 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true" .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "SeuEmail@gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "SenhaDoEmail" .Update On Error GoTo debugs End With With oMensagem Set .Configuration = oConfiguração .To = ComboBox1 'Destino do E-mail. .cc = "" 'com cópia .BCC = "" 'com cópia oculta .From = "<SeuEmail@gmail.com>" .Subject = TextBox2 'O titulo do e-mail recebe do TextBox2 .TextBody = sCorpo .AddAttachment strCaminho .send 'Label6 = "" If send Then Else If resposta = send Then MsgBox "E-mail Enviado com Sucesso" Call excluir_Arquivo_Enviado debugs: MsgBox "ERRO!!!! O E-mail Não Foi Enviado ! ! !", vbOKOnly + vbCritical If Err.Description <> "" Then MsgBox Err.Description, vbInformation, "Erro! E-mail Não Foi Enviado ! ! ! ! ! ! ! !" Kill ThisWorkbook.Path & "\" & TextBox1 & ".xlsx" UserForm1.Hide Application.ScreenUpdating = True End If End If End With End Sub Sub excluir_Arquivo_Enviado() On Error Resume Next Set objWS = CreateObject("WScript.Shell") Kill ThisWorkbook.Path & "\" & TextBox1 & ".xlsx" End End Sub
Espero ter ajudado!- Editado miguelinho70 domingo, 9 de novembro de 2014 10:27
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 15 de novembro de 2014 10:53