[Resolvido]Enviar Email com 2 ou mais Anexos, transformados de vários relatórios destintos.

Bom Dia !!!
Estou com um dilema..

estou com um DB com 5 Relatórios e tenho que enviá-los via Email para a mesma pessoa.
e faço isso um vez por dia..
porem cada vez que faço tenho que transformar o 5 relatórios em arquivo PDF e anexá-lo em um email destinto..
seria possível .
um código em VBA que possa transformar os 5 Relatórios em Arquivo VBA ao mesmo tempo e anexar eles em um único Email?


para gerar o aquivo em PDF e aguardá-lo em uma pasta, e anexa-lo no e-mail automaticamente eu tenho o Código, porem não sei como faze-lo para fazer isso com os 5 relatórios ao mesmo tempo ..
amigos deixo o Código que utilizo para vocês darem uma olhada
se possível e alguém poder me ajudar

desde já agradeço


segue o código

Dim Out As Outlook.Application
Dim ns As Outlook.NameSpace
Dim Folder As MAPIFolder
Dim Mens As MailItem
Dim objOutlookRec As Outlook.Recipient
Dim caminho As String
Dim strArquivo As String
Dim strEnderecos As String
Dim strDestinatarios
Dim StrEnvio
Dim stremail
Dim strEnderCC As String
Dim strDestinatCC
Dim StrEnvCC
Dim stremailComCop
Dim StrEnviCC
Dim fso As Object
Dim strLocal As String
Dim stDocName As String
Dim stLinkCriteria As String


Set Out = New Outlook.Application
Set ns = Out.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
Set Mens = Folder.Items.Add

On Error Resume Next


'Local onde a pasta deve ser criada
strLocal = CurrentProject.Path & "\Relatorio_AES_PES"

'Função Cria Pasta
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(strLocal) Then ' verifica se já existe a pasta
Else
' se não existir cria
MkDir strLocal
End If

'Inicio da Função

If IsNull(Me!DataFim) Then Exit Sub

strArquivo = "Relatório de programações.pdf"

caminho = CurrentProject.Path & "\Relatorio_AES_PES\" & strArquivo

stDocName = "rto_AES_SigCOD_Geral_E _Regiao"
'stLinkCriteria = "[Nome]= '" & Me!Nome & "'"


DoCmd.OpenReport stDocName, acViewPreview, , stLinkCriteria, acHidden
DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, caminho
DoCmd.Close acReport, stDocName







Set rst = CurrentDb.OpenRecordset(strEnderecos)




StrEnvio = Left(strDestinatarios, Len(strDestinatarios) - 2)
' FimLocalizar Email Supervisor e Auxiliares
'-------------------------------------------------------------

With Mens
Set objOutlookRec = .Recipients.Add(StrEnvio) ' Destinatario do Email"
.CC = ' Incluir aqui um segundo destinatário se for o caso"
'.BCC = 'Com Copia Oculta
'Incluir aqui texto da Mensagem"
.BodyHTML = "Segue Relatório Solicitado "
.Subject = ' Incluir aqui o Assunto da Mensagem
.Attachments.Add (caminho) ' Caminho Completo do Anexo
.Display ' Abre EMail mas não Envia Automatico
'.Send ' Envia Email Automaticamente sem Visualização.


rst.Close
Set rst = Nothing



End With



End Sub

Opa, vamos lá... Estou supondo que todos os PDFs são salvos na Pasta:  CurrentProject.Path & "\Relatorio_AES_PES\"

Primeiro altere suas variáveis para o tipo Array

Código:

Dim strArquivo(5) as String
Dim stDocName(5) as String
dim caminho(5) as String

Depois defina os nomes dos Arquivos PDF conforme abaixo

Código:

strArquivo(0)="Relatorio_1.pdf"
strArquivo(1)="Relatorio_2.pdf"
strArquivo(2)="Relatorio_3.pdf"
strArquivo(3)="Relatorio_4.pdf"
strArquivo(4)="Relatorio_5.pdf"

Devina também os nomes dos Relatórios

Código:

stDocName(0)="Nome_Relatorio_1"
stDocName(1)="Nome_Relatorio_2"
stDocName(2)="Nome_Relatorio_3"
stDocName(3)="Nome_Relatorio_4"
stDocName(4)="Nome_Relatorio_5"

Crie um For...Next e altere o seu código conforme abaixo:

Código:

For i=0 to 4

If IsNull(Me!DataFim) Then Exit Sub

caminho(i) = CurrentProject.Path & "\Relatorio_AES_PES\" & strArquivo(i)

DoCmd.OpenReport stDocName(i), acViewPreview, , stLinkCriteria, acHidden
DoCmd.OutputTo acOutputReport, stDocName(i), acFormatPDF, caminho(i)
DoCmd.Close acReport, stDocName(i)

Next

Agora crie mais um For...Next para os Anexos

Código:

For J=0 to 4
.Attachments.Add (caminho(J)) ' Caminho Completo do Anexo
Next

Obrigado mesmo irmão!!!
Cara ficou 1000%
Tenho só que agradecer.

Teria como postar o codigo completo depois que o mesmo funcionou por favor.

Viva
Excelente este código, mas funciona se o outlook já estiver aberto, como fazer para funcionar em ambas as situações (outlook aberto e fechado)?