MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Relatório email

    Compartilhe

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    [Resolvido]Relatório email

    Mensagem  Roberto_1977 em Qua 08 Out 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
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

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

    Re: [Resolvido]Relatório email

    Mensagem  Assis em Qua 08 Out 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 ***

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: [Resolvido]Relatório email

    Mensagem  Roberto_1977 em Qua 08 Out 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
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

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

    Re: [Resolvido]Relatório email

    Mensagem  Assis em Qua 08 Out 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


    [Você precisa estar registrado e conectado para ver este link.]


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

    Avelino Sampaio
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Relatório email

    Mensagem  Avelino Sampaio em Qua 08 Out 2014, 14:01

    Olá!

    aqui também neste meu artigo:

    [Você precisa estar registrado e conectado para ver este link.]

    Sucesso!


    .................................................................................
    ============ Quer aprender Access em alta velocidade ? ============

    || [Você precisa estar registrado e conectado para ver esta imagem.] Acesse o site UsandoAccess.com.br e veja um ótimo kit de ensino que tenho para você.

    ===========================================================

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: [Resolvido]Relatório email

    Mensagem  Roberto_1977 em Qua 08 Out 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


    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: [Resolvido]Relatório email

    Mensagem  Roberto_1977 em Qua 08 Out 2014, 17:47

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

    Obrigado....

    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

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

    Re: [Resolvido]Relatório email

    Mensagem  Assis em Qua 08 Out 2014, 18:23

    Obrigado pelo retorno

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



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

      Data/hora atual: Sex 09 Dez 2016, 11:33