MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


4 participantes

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

    Jerecardoso
    Jerecardoso
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 75%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 79
    Registrado : 12/07/2013

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

    Mensagem  Jerecardoso 6/9/2014, 04:30

    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










    LiveBrain
    LiveBrain
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 182
    Registrado : 15/05/2011

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

    Mensagem  LiveBrain 6/9/2014, 23:51

    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


    .................................................................................
    Abraços

    Live Brain Tutoriais

    "Fraca é a pessoa que não conhece a força que possui nos amigos"
    Jerecardoso
    Jerecardoso
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 75%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 79
    Registrado : 12/07/2013

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

    Mensagem  Jerecardoso 7/9/2014, 01:13

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


    Respeito às regras : Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 1
    Registrado : 12/10/2016

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

    Mensagem  priscilamafei 11/11/2016, 11:48

    Teria como postar o codigo completo depois que o mesmo funcionou por favor.
    avatar
    Motar
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 149
    Registrado : 03/08/2010

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

    Mensagem  Motar 26/2/2017, 22:57

    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)?

    Conteúdo patrocinado


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

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 28/3/2024, 17:23