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


2 participantes

    [Resolvido]Relatório email

    avatar
    Convidado
    Convidado


    [Resolvido]Relatório email Empty [Resolvido]Relatório email

    Mensagem  Convidado 8/10/2014, 11:16

    Bom dia,

    Estou com um pequeno problema, Tenho um código que envia email sem anexo, e eu gostaria de poder introduzir em anexo o relatorio em PDF.
    Vou postar os 2 códigos que tenho para saber se dava para juntar estes 2 codigos e formar um só:
    1º - Serve para modificar o nome do relatório ao passar para PDF
    2º - Serve para enviar email.



    DoCmd.OpenReport Form_Dif_filtro.Text4.Value, acViewDesign, , , acHidden
    Reports(Form_Dif_filtro.Text4).Caption = Form_sub_report_metros.Text339.Value
    DoCmd.Close acReport, Form_Dif_filtro.Text4.Value, acSaveYes



    Dim appOutlook As Object
    Dim olMail As Object

    'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
    On Error Resume Next
    Set appOutlook = GetObject(, "Outlook.Application")
    If appOutlook Is Nothing Then
    Set appOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail

    With olMail
    .To = Text207
    .CC = "" & Me.Text209
    .Subject = Me.Nome_Cliente_Final
    '.Attachments.Add (CurrentProject.Path & "\" & "teste.xlsx")
    .Body = Me.Text237 + vbNewLine + vbNewLine + Me.Text234.Value + vbNewLine + "OK para expedir." + vbNewLine + "Obrigado." + vbNewLine + vbNewLine + vbNewLine + "Roberto" + vbNewLine + "Área Medição"
    .Send
    End With
    MsgBox "Email enviado com sucesso." & vbCrLf & "Para: " & Me.Text207.Value & vbCrLf & "Cc: " & Me.Text209.Value, vbInformation, "Email"

    End Sub

    Agradeço Ajuda... Cool
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4772
    Registrado : 06/11/2009

    [Resolvido]Relatório email Empty Re: [Resolvido]Relatório email

    Mensagem  Assis 8/10/2014, 11:50

    Roberto

    Uso esta função e envio até 3 Anexos (a vermelho), pelo mail do Sapo

    Sub EnviarEmail()
    On Error GoTo erromail
    Dim Mens As CDO.Message
    Dim Config As CDO.Configuration
    Set Config = New CDO.Configuration
    With Config
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Me.SMTP 'aqui foi configurado para uma conta de email do sapo, que é grátis
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Me.Porta ' porta usada pelo sapo
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = Me.Email 'se o email a ser usado para envio for fulano@pt, coloque fulano aqui
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Me.Pass 'coloque a senha do seu email
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

    .Fields.Update
    End With

    Set Mens = New CDO.Message
    With Mens
    Set .Configuration = Config
    .From = Forms!Menu!Mail 'envia
    If Not IsNull(Me.txtDeMail) Then
    .Sender = Me.Email 'email de quem envia.
    End If
    If Not IsNull(Me.txtCOculta) Then
    .BCC = Me.txtCOculta
    End If
    .Subject = Me.txtAssunto 'caixa texto assunto
    .TextBody = Me.txtMensagem 'Caixa texto com o texto
    .To = Me.txtPara 'caixa texto para quem vai o email"
    If Not IsNull(Me.txtAnexo) Then
    .AddAttachment (Me.txtAnexo)
    End If
    If Not IsNull(Me.txtAnexo1) Then
    .AddAttachment (Me.txtAnexo1)
    End If
    If Not IsNull(Me.txtAnexo2) Then
    .AddAttachment (Me.txtAnexo2)
    End If


    DoCmd.openForm "frmProgresso"
    .Send ' envia

    End With
    MsgBox "@Mail Enviado com Sucesso", vbExclamation, "Gestão de @Mails"
    DoCmd.Close acForm, "frmProgresso"
    DoCmd.Close acForm, "email"
    Set Mens = Nothing
    Set Config = Nothing

    Exit Sub
    erromail:
    If IsNull(Me!txtPara) Or Me!txtPara = "" Then
    MsgBox "Falta o Mail do Destinatário", vbExclamation, "Gestão de @Mails"
    Me.txtPara.SetFocus
    Me.txtPara.Dropdown
    Exit Sub
    End If

    'MsgBox err.Number & " " & err.Description
    Set Mens = Nothing
    Set Config = Nothing

    Exit Sub

    End Sub


    .................................................................................
    *** Só sei que nada sei ***
    avatar
    Convidado
    Convidado


    [Resolvido]Relatório email Empty Re: [Resolvido]Relatório email

    Mensagem  Convidado 8/10/2014, 13:45

    Boa tarde Assis,

    Eu envio o email através do Outlook que temos instalado nos PC da empresa.
    Só queria mesmo poder anexar um report convertido em PDF ao código que eu postei.

    Obrigado Smile
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4772
    Registrado : 06/11/2009

    [Resolvido]Relatório email Empty Re: [Resolvido]Relatório email

    Mensagem  Assis 8/10/2014, 13:58

    Roberto
    Tem de criar um campo na tabela texto, para guardar o caminho do documento (PDF) .... exemplo "Anexo"

    Criar um campo no formulario de enviar email. Exemplo txtAnexo

    acrescentar este código

    If Not IsNull(Me.txtAnexo) Then
    .AddAttachment (Me.txtAnexo)
    End If


    http://maximoaccess.forumeiros.com/t20420-resolvidoenviar-email-com-2-ou-mais-anexos-transformados-de-varios-relatorios-destintos#150374


    .................................................................................
    *** Só sei que nada sei ***
    Avelino Sampaio
    Avelino Sampaio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3900
    Registrado : 04/04/2010

    [Resolvido]Relatório email Empty Re: [Resolvido]Relatório email

    Mensagem  Avelino Sampaio 8/10/2014, 14:01

    Olá!

    aqui também neste meu artigo:

    http://www.usandoaccess.com.br/tutoriais/gerar-relatorios-em-pdf-e-enviar-por-email.asp?id=1#inicio

    Sucesso!


    .................................................................................
    Vídeos, livros, kit MontaRibbons e acesso vitalício ao site UsandoAcces  
    Clique AQUI e analise o custo beneficio do material oferecido.
    avatar
    Convidado
    Convidado


    [Resolvido]Relatório email Empty Re: [Resolvido]Relatório email

    Mensagem  Convidado 8/10/2014, 17:46

    Boa tarde,

    Com o código que o Assis postou, ficou a funfar 5 *****.
    Só tive que ajustar um pouco o meu código.
    A BD agora guarda relatório numa pasta se ela existir ou então cria uma nova e anexa o relatório que quero ao email.

    Vou postar como ficou o meu código....pode estar um pouco confuso por eu não atribuir os nomes as caixas de texto, mas eu me entendo.

    Private Sub Command51_Click()
    Dim appOutlook As Object
    Dim olMail As Object
    Dim strArquivo As String
    Dim strLocal As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    strArquivo = "" & Form_sub_report_metros.Text339 & ".pdf"
    strLocal = CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126 & "\" & Form_sub_report_metros.Text411 & "\" & strArquivo
    If fso.folderexists(CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126 & "\" & Form_sub_report_metros.Text411) Then
    DoCmd.OutputTo acOutputReport, Form_Dif_filtro.Text4.Value, acFormatPDF, strLocal
    MsgBox "Arquivo criado com sucesso.", vbInformation, "Enviar para " & Form_sub_report_metros.Text126
    End If
    If Not fso.folderexists(CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126) Then
    MkDir CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126
    MkDir CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126 & "\" & Form_sub_report_metros.Text411
    DoCmd.OutputTo acOutputReport, Form_Dif_filtro.Text4.Value, acFormatPDF, strLocal
    MsgBox "Arquivo criado com sucesso.", vbInformation, "Enviar para " & Form_sub_report_metros.Text126
    End If
    If Not fso.folderexists(CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126 & "\" & Form_sub_report_metros.Text411) Then
    MkDir CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126 & "\" & Form_sub_report_metros.Text411
    DoCmd.OutputTo acOutputReport, Form_Dif_filtro.Text4.Value, acFormatPDF, strLocal
    MsgBox "Arquivo criado com sucesso.", vbInformation, "Enviar para " & Form_sub_report_metros.Text126
    End If

    'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
    On Error Resume Next
    Set appOutlook = GetObject(, "Outlook.Application")
    If appOutlook Is Nothing Then
    Set appOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail

    With olMail
    .To = "Meu_email@hotmail.com"
    .CC = "Meu_email@hotmail.com"
    .Subject = "Meu_email@hotmail.com"
    If Not IsNull(strLocal) Then
    .Attachments.Add (strLocal)
    End If
    '.Attachments.Add (CurrentProject.Path & "\" & "teste.xlsx")
    .Body = "Meu_email@hotmail.com" + vbNewLine + vbNewLine + "Meu_email@hotmail.com" + vbNewLine + "OK para expedir." + vbNewLine + "Obrigado." + vbNewLine + vbNewLine + vbNewLine + "O seu nome" + vbNewLine + "Área"
    .Send
    End With
    MsgBox "Email enviado com sucesso." & vbCrLf & "Para: " & "Meu_email@hotmail.com" & vbCrLf & "Cc: " & "Meu_email@hotmail.com", vbInformation, "Email"

    End Sub


    Obrigado Smile

    avatar
    Convidado
    Convidado


    [Resolvido]Relatório email Empty Re: [Resolvido]Relatório email

    Mensagem  Convidado 8/10/2014, 17:47

    E agradeço também a ajuda ao Avelino.

    Obrigado....
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4772
    Registrado : 06/11/2009

    [Resolvido]Relatório email Empty Re: [Resolvido]Relatório email

    Mensagem  Assis 8/10/2014, 18:23

    Obrigado pelo retorno

    Como diz o GRANDE JPaulo
    Há muitas maneiras de fazer nestum
    Abraço



    .................................................................................
    *** Só sei que nada sei ***

    Conteúdo patrocinado


    [Resolvido]Relatório email Empty Re: [Resolvido]Relatório email

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 8/11/2024, 06:49