Ir ao conteúdo
  • Cadastre-se
djacy.neto

Excel macro envio de emails

Posts recomendados

pessoal tenho uma macro para enviar emails, e o que esta acontecendo é:

cada email tem um anexo, mais ele esta juntando os anexos ao enviar.

ele deve enviar email1 anexo1, email2 anexo2,

e esta enviando assim email1 anexo1 email2 anexo1 anexo2...

e a cada email ele vai agrupando os anexos.

segue codigo abaixo:

 Sheets("Geral").Select
   ActiveSheet.Range("c38:ao75").Select
   Application.CutCopyMode = False
   Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        
   ActiveWorkbook.EnvelopeVisible = True
  
   With ActiveSheet.MailEnvelope
    .Introduction = "Boa tarde!" + vbCrLf + " " + vbCrLf + "Segue quadro"
    .Item.to = "email@email.com.br"
    .Item.Cc = "email@email.com.br"
    .Item.Subject = "assunto"
    .Item.Attachments.Add "P:\arquivo.xlsx"
    .Item.Send

excel 2019

Compartilhar este post


Link para o post
Compartilhar em outros sites

 

Disponibilize o código inteiro.

Compartilhar este post


Link para o post
Compartilhar em outros sites

@osvaldomp esse é o codigo, a unica coisa que eu faco é replicar 

 

 Sheets("Geral").Select
   ActiveSheet.Range("c38:ao75").Select
   Application.CutCopyMode = False
   Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        
   ActiveWorkbook.EnvelopeVisible = True
  
   With ActiveSheet.MailEnvelope
    .Introduction = "Boa tarde!" + vbCrLf + " " + vbCrLf + "Segue quadro"
    .Item.to = "email@email.com.br"
    .Item.Cc = "email@email.com.br"
    .Item.Subject = "assunto"
    .Item.Attachments.Add "P:\arquivo1.xlsx"
    .Item.Send
   end with

 Sheets("Geral").Select
   ActiveSheet.Range("c38:ao75").Select
   Application.CutCopyMode = False
   Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        
   ActiveWorkbook.EnvelopeVisible = True
  
   With ActiveSheet.MailEnvelope
    .Introduction = "Boa tarde!" + vbCrLf + " " + vbCrLf + "Segue quadro"
    .Item.to = "email@email.com.br"
    .Item.Cc = "email@email.com.br"
    .Item.Subject = "assunto"
    .Item.Attachments.Add "P:\arquivo2.xlsx"
    .Item.Send
   end with

 Sheets("Geral").Select
   ActiveSheet.Range("c38:ao75").Select
   Application.CutCopyMode = False
   Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        
   ActiveWorkbook.EnvelopeVisible = True
  
   With ActiveSheet.MailEnvelope
    .Introduction = "Boa tarde!" + vbCrLf + " " + vbCrLf + "Segue quadro"
    .Item.to = "email@email.com.br"
    .Item.Cc = "email@email.com.br"
    .Item.Subject = "assunto"
    .Item.Attachments.Add "P:\arquivo3.xlsx"
    .Item.Send
   end with
end sub

o que muda sao os anexos e os emails destino..

Compartilhar este post


Link para o post
Compartilhar em outros sites

 

Em cada trecho do código que envia um email acrescente as 3 linhas em vermelho conforme abaixo.

 

   .Item.Subject = "assunto"
   
On Error Resume Next
    .Item.Attachments(1).Delete
    On Error GoTo 0

    .Item.Attachments.Add "P:\arquivo1.xlsx"

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Redes de Computadores - Gabriel Torres

PROMOÇÃO DE QUARENTENA

De R$ 39,90 por apenas R$ 9,90 só até as 23h59min desta sexta-feira 03/04/2020

CLIQUE AQUI E COMPRE AGORA MESMO!