Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Macro enviar Email

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
klifgdf
Colaborador
Colaborador
Mensagens: 10
Registrado em: Sex Mai 26, 2017 4:23 pm

Macro enviar Email

Mensagem por klifgdf »

Boa noite,
Galera, eu tenho o codigo abaixo que peguei na net para enviar e-mail, como não tenho muito conhecimento em VBA as vezes que alterei o codigo sempre da erro.

na macro abaixo ele só insere os emails para as pessoa que quero enviar e o titulo, eu preciso que a macro coloque também emails em copia e que eu possa digitar o texto do corpo do e-mail.

Código: Selecionar todos

Private Sub CommandButton2_Click()
Dim NovoArquivoXLSX 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 = "DADOS"
 
 'Cria um novo arquivo excel
 Set NovoArquivoXLSX = Application.Workbooks.Add
 
 'Copia a planilha para o novo arquivo criado

 ThisWorkbook.Sheets(sPlanAEnviar).Copy before:=NovoArquivoXLSX.Sheets(1)
 
 Columns("A:Q").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
 'NovoArquivoXLS.Sheets(1).PasteSpecial xlValues
 
 'Salva o arquivo
 NovoArquivoXLSX.SaveAs ThisWorkbook.Path & "\" & sPlanAEnviar & ".xlsx"

sExcluirAnexoTemporario = NovoArquivoXLSX.FullName

 'Envia o email
 NovoArquivoXLSX.SendMail Recipients:=Array("email@teste.com"), Subject:="Relatorio de Corte"
 
 
 
 
 'Fecha o arquivo novo
 NovoArquivoXLSX.Close
 
'Exclui o arquivo criado apenas para ser enviado.
Kill sExcluirAnexoTemporario



End Sub




se poderem me ajudar agradeço


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Wagner Morel
Manda bem
Manda bem
Mensagens: 107
Registrado em: Qua Nov 29, 2017 11:51 am
Localização: Fortaleza - CE

Re: Macro enviar Email

Mensagem por Wagner Morel »

klifgdf0,

Boa tarde!

Não entendi... o código anexado abaixo nada tem a ver com envio de email's.


klifgdf
Colaborador
Colaborador
Mensagens: 10
Registrado em: Sex Mai 26, 2017 4:23 pm

Re: Macro enviar Email

Mensagem por klifgdf »

Boa tarde!
Wagner Morel,

a macro citada ela cria a copia do meu arquivo para enviar por e-mail.

abaixo segue a parte do codigo onde é inserido os emails e o titulo,
é nesta parte que tento alterar e sempre da erro.

Código: Selecionar todos

'Envia o email
 NovoArquivoXLSX.SendMail Recipients:=Array("email@teste.com"), Subject:="Relatorio de Corte"


Wagner Morel
Manda bem
Manda bem
Mensagens: 107
Registrado em: Qua Nov 29, 2017 11:51 am
Localização: Fortaleza - CE

Re: Macro enviar Email

Mensagem por Wagner Morel »

klifgdf0,

Bom dia!

Existem formas mais práticas de enviar e-mail diretamente do Excel. Anexe seu arquivo aqui no fórum, compactado com .ZIP e informe se envia email pelo outlook ou por outro provedor de email.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


klifgdf
Colaborador
Colaborador
Mensagens: 10
Registrado em: Sex Mai 26, 2017 4:23 pm

Re: Macro enviar Email

Mensagem por klifgdf »

Boa tarde!
Obrigado aos que deram atenção.

consegui resolver o meu problema.

peguei um outro codigo de enviar email e inseri algumas linhas do codigo anterior.

abaixo segue codigo caso alguem nescessite.



Código: Selecionar todos

Private Sub CommandButton2_Click()

' Don't forget to copy the function GetBoiler in the module.
 Dim OutApp As Object
 Dim OutMail As Object
 Dim strbody As String
 Dim SigString As String
 Dim Signature As String
 Dim NovoArquivoXLSX 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 = "DADOS"
 
 'Cria um novo arquivo excel
 Set NovoArquivoXLSX = Application.Workbooks.Add
 
 'Copia a planilha para o novo arquivo criado

 ThisWorkbook.Sheets(sPlanAEnviar).Copy before:=NovoArquivoXLSX.Sheets(1)
 
 Columns("A:Q").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
   'Salva o arquivo
 NovoArquivoXLSX.SaveAs ThisWorkbook.Path & "\" & sPlanAEnviar & ".xlsx"

sExcluirAnexoTemporario = NovoArquivoXLSX.FullName
 

 

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & _
    "Local da assinatura"
  
 If Dir(SigString) <> "" Then
 
    Signature = GetBoiler(SigString)
    
    Signature = ""
 Else
 
   
    
 End If
 
    On Error Resume Next
    
    
 With OutMail
  .To = "Emails@teste.com.br"
  .CC = "Emails@teste.com.br"
  .Subject = "Titulo do email"
  .HTMLBody = .strbody & "<br>" & Signature
  .Attachments.Add ("Local do Arquivo")

  .Display 'or use .Send
  
 End With
 
  On Error GoTo 0
  
   Set OutMail = Nothing
   Set OutApp = Nothing
   'Fecha o arquivo novo
 NovoArquivoXLSX.Close
 'Exclui o arquivo criado apenas para ser enviado.
Kill sExcluirAnexoTemporario
 
 
 
 End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder