Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Enviar VARIOS anexo...
 
Notifications
Clear all

Enviar VARIOS anexos para o mesmo email

 
2024 - VBA & Macros
4 Posts
2 Usuários
0 Reactions
1,605 Visualizações
RSS
 JokerPot
(@jokerpot)
Posts: 0
New Member
Topic starter
 

Bom Dia!

Pessoal, tenho uma rotina que seleciona e envia por email arquivos através de uma planilha.
Hoje essa rotina envia 1 arquivo por email independente se o destinatário é o mesmo para arquivos diferentes.

O que eu gostaria de implementar é de enviar VARIOS anexos na medida em que o destinatário seja o mesmo afim de evitar vários envios de e-mails ao mesmo destinatário com anexos diferentes.

Conseguem me ajudar?

Abraços.

Sub EMAILS()

Application.ScreenUpdating = False



Sheets("DADOS").Select

Cells(2, 2).Select
ActiveSheet.Paste


Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range("$A$1:$B$1048576").RemoveDuplicates Columns:=1, Header:=xlYes

Dim Pergunta As Variant
Pergunta = MsgBox("O Outlook está aberto?", 4 + 32, "E-mail")
If Pergunta = vbNo Then
    MsgBox "Abra o Outlook para comandar a exportação dos dados", vbOKOnly, "Envio"
    Exit Sub
End
End If
        
Dim olapp As Object
Dim oitem As Object


x_CAMINHO = Sheets("PARAMETROS").Range("$H$3").Value & ""
ASSUNTO = Sheets("PARAMETROS").Range("$K$2").Value
MENSAGEM_1 = Sheets("PARAMETROS").Range("$K$4").Value
MENSAGEM_2 = Sheets("PARAMETROS").Range("$K$5").Value
DATA_1 = Sheets("PARAMETROS").Range("$K$6").Value
MENSAGEM_3 = Sheets("PARAMETROS").Range("$K$7").Value
DATA_2 = Sheets("PARAMETROS").Range("$K$8").Value
MENSAGEM_4 = Sheets("PARAMETROS").Range("$K$9").Value
MENSAGEM_5 = Sheets("PARAMETROS").Range("$K$10").Value
MENSAGEM_6 = Sheets("PARAMETROS").Range("$K$11").Value
MENSAGEM_7 = Sheets("PARAMETROS").Range("$K$12").Value
MENSAGEM_8 = Sheets("PARAMETROS").Range("$K$13").Value
'IMAGEM = Sheets("PARAMETROS").Range("$K$49").Select



Sheets("DADOS").Select

ULTIMA_LINHA = Sheets("DADOS").Range("A1048576").End(xlUp).Row

For n_linha = 2 To ULTIMA_LINHA
    
x_ARQUIVO = "FORECAST - " & Cells(n_linha, 1).Value & ".xlsm"
X_EMAIL = Cells(n_linha, 2).Value
'Workbooks.Open Filename:=(x_CAMINHO & "" & x_ARQUIVO)
            Set olapp = CreateObject("Outlook.Application")
            Set oitem = olapp.CreateItem(0)
            With oitem
                .Subject = ASSUNTO & " " & DATA_2
                .To = X_EMAIL
                .CC = X_EMAIL
                .Attachments.Add "C:UsersXXXXXXXDesktopCalendario11.NovembroNovembro.png", olByReference, 1
    .HTMLBody = _
   "<HTML>" & vbNewLine & _
      "<BODY style=font-size:10pt;font-family:Century Gothic> " & vbNewLine & _
         "<font color=""black""> " & MENSAGEM_1 & "<P>" & vbNewLine & _
         "<font color=""black""> " & MENSAGEM_2 & "</font>" & "<font color=""red""> " & DATA_1 & "<P>" & vbNewLine & _
         "<font color=""black""> " & MENSAGEM_3 & "</font>" & "<font color=""red""> " & DATA_2 & "<P>" & vbNewLine & _
         "<font color=""black""> " & MENSAGEM_4 & "</font>" & "<font color=""red""> " & MENSAGEM_5 & "</font>" & "<font color=""black""> " & MENSAGEM_6 & "<P>" & vbNewLine & _
         "<font color=""black""> " & MENSAGEM_7 & "<P>" & vbNewLine & _
         "<font color=""black""> " & MENSAGEM_8 & "<P>" & vbNewLine & _
      "</BODY>" & vbNewLine & _
      "<img border='0' src='C:UsersXXXXXXDesktopCalendarioOutubro.jpg'  width='610' height='148'>"
'   "</HTML>"
   
                            
'               .Attachments.Add ActiveWorkbook.FullName
                .Attachments.Add (x_CAMINHO & x_ARQUIVO)
                
                .SEND
            End With
'    Application.DisplayAlerts = False
'    ActiveWorkbook.Close
'    Application.DisplayAlerts = True
Next
    MsgBox "Envio Efetuado.", vbOKOnly, "Envio"
'    ActiveWindow.Close
Sheets("forecast").Select
Range("$B$5").Select
End Sub
EXEMPLO1 (2).zip
 
Postado : 17/01/2018 7:56 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Já tentou algo assim?

Dim files As Variant, file As Variant
files = Split(filepath, ",")
For Each file In files
    .attachments.Add file
Next

Favor adaptar!!!
Att

 
Postado : 17/01/2018 10:49 am
 JokerPot
(@jokerpot)
Posts: 0
New Member
Topic starter
 

Boa tarde!!

Já tentou algo assim?

Dim files As Variant, file As Variant
files = Split(filepath, ",")
For Each file In files
    .attachments.Add file
Next

Favor adaptar!!!
Att

alexandrevba boa tarde!
Infelizmente nao deu certo. A rotina passa direto e finaliza sem fazer nada.
Existe alguma outra possibilidade?

Abraços.

 
Postado : 18/01/2018 1:19 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

No meu teste eu usei o outlook, não tive problema.

Talvez eu tenha entendido errado.

Vamos ver se mais alguém possa ajudar.

Att

 
Postado : 31/01/2018 5:36 am
Forum Jump:
  Tópico Anterior
Próximo Tópico