[Resolvido]Adicionar Relatório no corpo do e-mail

Olá Pessoal,

Gostaria de pedir mais uma ajuda

Tenho o seguinte código abaixo, ele envia uma mensagem de e-mail com arquivos anexos, porém, preciso adicionar no corpo desse e-mail após "Prezados" e antes de "Me!Assinatura" um relatório. Isso é possível?

Procurei na internet mas geralmente as pessoas criam formulários como a caixa do outlook, e não é bem isso que eu preciso.


PS.: Eu li em alguns lugares que esses relatórios tem que ser salvos em HTML para então adiciona-los no corpo do e-mail, mas não tenho a menor noção de como fazer isso.

Código:

Private Sub Btn_Email_Click()

 
Dim strLocalDemonstr As String
Dim strLocalBoleto As String
Dim bolExisteFicheiro As Boolean

Dim objOut As Object
Dim objmail As Object
Dim objAnexo As Object
Const olMailItem = 0
Const olByValue = 1

    Set objOut = CreateObject("Outlook.application")
    Set objmail = objOut.CreateItem(olMailItem)
    Set objAnexo = objmail.Attachments

    With objmail
        .SentOnBehalfOfName = Me!Conta
        .To = Me("E-mail")
        .Subject = Me!Assunto & " - " & Me!Segurado
        .Body = "Prezados (as)," & vbNewLine & vbNewLine & Saudacao & vbNewLine & vbNewLine _
                & Me!Mensagem & vbNewLine & vbNewLine & vbNewLine & vbNewLine _
                & Me!Assinatura & vbNewLine & vbNewLine
        .Save

 
    'Anexa o BOLETO no e-mail
    strLocalBoleto = CurrentProject.Path & "\Print's\" & Me("Renomear Boleto") & ".pdf"
    If Dir(strLocalBoleto) = "" Then
        bolExisteFicheiro = True
    
    Else
        bolExisteFicheiro = False
        objAnexo.Add strLocalBoleto, olByValue, 1

    End If
    .Display

End With

Set objAnexo = Nothing
Set objmail = Nothing
Set objOut = Nothing

If bolExisteFicheiro Then
    MsgBox "O boleto não foi anexado." & vbNewLine & "Verifique o nome do arquivo ou se ele está salvo no local correspondente."

End If
End Sub

Desde já agradeço novamente, esse fórum tem sido incrível!


Att,
Cy Rangel

Pessoal,

Eu não sei se ajuda, mas encontrei esse tópico no site do "Avelino", tentei aplicar no meu código mas não consegui:

https://www.usandoaccess.com.br/dicas/outlook-anexos-richtext-account.asp#video


Desde já agradeço,

Att
Cy Rangel

Também já tentei, sem sucesso, adicionar um relatório da forma como você quer.

Se alguém conseguir, vou copiar!


O que eu fiz foi exportar um unico relatorio em HTML e aí fazer ele ser o corpo do email, mas minhas tentativas para incluir textos antes e depois foram infrutíferas.

Para exportar em HTML um relatório da agenda e mandar por email fiz assim:

Código:

Public Function AgendaMailHoje()

DoCmd.OpenReport "AgendaHoje", acViewPreview, "", , acHidden
DoCmd.OutputTo acOutputReport, "AgendaHoje", "HTML(*.html)", localW & "iA_Advogado\Agenda.html", False, "", , acExportQualityPrint
DoCmd.Close acReport, "AgendaHoje", acSaveNo

              Dim i As Long
              Dim strMessagePath As String
              Dim strSubject As String
              Dim strHTM() As String
         
              Dim MyItem As Object
              Dim objOut As Object
              Dim strAssunto As String
              Dim HTMLBody As String
         
              Dim strEmail As String
              Dim strNick As String
              Dim strLocal As String
             
              strAssunto = txt_advApelido & ", veja sua agenda de hoje!"
             
              strMessagePath = localW & "iA_Advogado\Agenda.html"
                           
              strEmail = txt_advMail
              strNick = txt_advApelido

              Set objOut = CreateObject("Outlook.application")
              Set MyItem = objOut.CreateItem(olMailItem)

                With MyItem
                .Subject = strSubject
                FileToArray strMessagePath, strHTM
                For i = 0 To UBound(strHTM)
               
                .HTMLBody = .HTMLBody & strHTM(i) & vbCr
                Next i

                .Display
                .To = strEmail
                .Subject = strAssunto
                .Send
                End With
           
                   
            TempVars.RemoveAll

End Function

@annissima,

Muito obrigada pela ajuda.

Retirei os códigos que condiziam apenas ao seu relatório, adaptei ao meu, mas não funcionou. Falta alguma referência que não estou sabendo conectar.

Eu vou tentar também em algum forum de outro país e se eu conseguir a resposta, eu volto neste post e deixo aqui para você! Isso se alguém não nos retornar, rs...


Agradeço novamente.

Att
Cy Rangel.

Pessoal,

Eu consegui adaptar o meu código e inserir o relatório no corpo do e-mail.

[color=#0000ff]
@annissima, consegui também adicionar uma mensagem no corpo do e-mail, mas apenas antes do "Relatório", após, eu não consegui de forma alguma, nem mesmo a assinatura com qualquer texto (o que para mim já serviria).

[b]Se alguém ver essa mensagem e souber como e quiser nos ajudar quanto a essa parte de inserir texto após o relatório


PS.: Esse código é aplicado dentro de um FRM que é lincado com um relatório que possuí vários registros.
No relatório é necessário acessar a "Fonte de Registro", ir modo Design e no campo que tem a mesma informação que consta no FRM, na linha de "critérios", pelo construtor vincular o mesmo campo que existe no FRM.

Segue o vídeo onde eu aprendi como fazer esse link e logo após o código completo:

https://www.youtube.com/watch?v=FBYUyKMRxeI

Código:

Public Function fncLerArquivo(ByVal strLocalCorpoEmail As String) As String
'É NECESSÁRIO ADICIONAR ESSA FUNÇÃO NO INÍCIO ANTES DE QUALQUER CÓDIGO

Dim objfso As Object
Dim objts As Object

On Error Resume Next

Set objfso = CreateObject("Scripting.FileSystemObject")
Set objts = objfso.GetFile(strLocalCorpoEmail).OpenAsTextStream(1, -2)
fncLerArquivo = objts.readall

objts.Close
Set objfso = Nothing

End Function

Private Sub Btn_Email_Click()

Dim strLocalBoleto As String
Dim bolExisteFicheiro As Boolean
Dim strLocalCorpoEmail As String 'acrescentar essa e a variavel a seguir
Dim strBody As String

Dim objOut As Object
Dim objmail As Object
Dim objAnexo As Object
Const olMailItem = 0
Const olByValue = 1

    Set objOut = CreateObject("Outlook.application")
    Set objmail = objOut.CreateItem(olMailItem)
    Set objAnexo = objmail.Attachments

    With objmail
        .SentOnBehalfOfName = Me!Conta
        .To = Me("E-mail")
        .Subject = Me!Assunto & " - " & Me!Segurado
      
'Gera o relatório em HTML para adicionar no corpo do e-mail
    strBody = "Dê um nome para o seu relatório" & ".html" 'Chama a variavel nome do arquivo
    strLocalCorpoEmail = CurrentProject.Path & "\Print's" & strBody 'Chama a variavel Local e concatena com o nome do arquivo
    
    DoCmd.OpenReport "NOME DO SEU RELATÓRIO", acViewPreview, , "ID RELATORIO=" & Me!IDFORM, acHidden 'Abre o relatório no registro especifico selecionado no FORM. O 1º nome "ID RELATORIO=" é o nome do campo do seu relatório em Fonte do Controle e o 2º Me!IDFORM é nome do campo do Form (campo "Nome").
    DoCmd.OutputTo acOutputReport, "NOME DO SEU RELATÓRIO", acFormatHTML, strLocalCorpoEmail
    DoCmd.Close acReport, "NOME DO SEU RELATÓRIO" 'Fecha o relatório


'Add o relatório no corpo do email
    .BodyFormat = olFormatHTML
    .HTMLBody = "<BODY Style = Font-size:11pt;font-family:Calibri> Prezados(as),<br><br>" & fncLerArquivo(strLocalCorpoEmail)
    

        .Save

 
    'Anexa o BOLETO no e-mail
    strLocalBoleto = CurrentProject.Path & "\Print's" & Me("Renomear Boleto") & ".pdf"
    If Dir(strLocalBoleto) = "" Then
        bolExisteFicheiro = True
    
    Else
        bolExisteFicheiro = False
        objAnexo.Add strLocalBoleto, olByValue, 1

    End If
    .Display

End With

Set objAnexo = Nothing
Set objmail = Nothing
Set objOut = Nothing

If bolExisteFicheiro Then
    MsgBox "O boleto não foi anexado." & vbNewLine & "Verifique o nome do arquivo ou se ele está salvo no local correspondente."

End If
End Sub

Se está resolvido, faltou então marcar o tópico como Resolvido.

Aguardamos.