Enviar dados de um formulário no corpo do email

Código:



Mensagem = [lbl_saudacao] & " Luiza. <br><br>" _
& "Segue Fechamento do Caixa do dia: " & Date & "<br><br>" _
& "<b>Saldo Abertura:     </b> " & Format([saldo_abertura], "#,##0.00;-#,##0.00") & "<br><br>" _
& "<b>Vendas Dinheiro:     </b>  " & Format([total_dinheiro], "#,##0.00;-#,##0.00") & "<br><br>" _
& "<b>Vendas Crédito:     </b>  " & Format([total_credito], "#,##0.00;-#,##0.00") & "<br><br>" _
& "<b>Vendas Débito:      </b>  " & Format([total_debito], "#,##0.00;-#,##0.00") & "<br><br>" _
& "<b>Total Reforço:        </b>  " & Format([total_reforco], "#,##0.00;-#,##0.00") & "<br><br>" _
& "<b>Total Sangria:        </b>  " & Format([total_sangria], "#,##0.00;-#,##0.00") & "<br><br>" _
& "<b>Total Cancelado:      </b>  " & Format([total_cancelada], "#,##0.00;-#,##0.00") & "<br><br>" _
& "<b>Total Devolvido:      </b>  " & Format([total_devolucao], "#,##0.00;-#,##0.00") & "<br><br>" _
& "<b>Total Despesas:      </b>  " & Format([total_despesas], "#,##0.00;-#,##0.00") & "<br><br>" _
& "<b>Total Vendas:       </b>  " & Format([total_vendas], "#,##0.00;-#,##0.00") & "<br><br>" _
& "<b>Saldo em Caixa:   &nbsp;</b>  " & Format([total_caixa], "#,##0.00;-#,##0.00") & "<br><br><br>" _
& "Fico á disposição para maiores detalhes. <br><br>" _
& "Atenciosamente.<br><br>" _
& StrConv(DLookup("usuário", "tbl_sessao"), 3) & "<br>" _
& email_usuario & "<br>" _
& StrConv([setor_usuario], 3) & "<br><br>" _
& "------------------------------------------------------------------------------- " & vbCrLf _
& "Mensagem automática do <b>PDV <b>" & Format(Date, "yyyy") & "</b>"



Código:


Public Sub Email_Vendas(Remetente As String, email_destinatarios As String, _
Assunto As String, Corpo As String, Optional cc As String, Optional BCC As String)
   
On Error Resume Next
   
   
    Dim iMsg As Object
    Dim iConf As Object
    Dim strBody As String
    Dim senha As String
    Dim assinatura
    Dim topom
    Dim anexo
   
'DoCmd.OutputTo acOutputReport, "RELT_VENDAS_PERIODO", "PDFFormat(*.pdf)", CurrentProject.Path & "\RELATORIOS\RELT VENDAS " & Format(Now, "dd-mm-yyyy") & ".pdf", False, "", 0, acExportQualityScreen

    senha = "sua senha"
   
    anexo = Forms!Mensagens!RotaArquivo

    '    Dim Flds As Variant
 
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
 
        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.seuemail.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "email@seudominio.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "sua senha"
            .Update
        End With

  strBody = Corpo
 
    With iMsg
        Set .Configuration = iConf
        .To = email_destinatarios
        .cc = cc
        .BCC = BCC
        .From = Remetente
        '.AddAttachment CurrentProject.Path & "\RELATORIOS\RELT VENDAS " & Format(Date, "dd-mm-yyyy") & ".pdf"
        .Subject = Assunto
        '.TextBody = strBody
        .HTMLBody = strBody
        .HTMLBody = "<table border=0><tr><td>" & Replace(Me.Mensagem, vbCrLf, "<br>") & "</td></tr></table>"
        .Send
    End With

    iMsg.Close
    Set iMsg = Nothing

    iConf.Close
    Set iConf = Nothing

End Sub





Código:


  Call Email_Vendas(Me.Remetente, Me.email_destinatarios, Me.Assunto, Me.Mensagem)


Código:



Option Compare Database
Option Explicit

Const olMailItem = 0
Const olByValue = 1
Const urlImg As String = "http://i68.tinypic.com/313sy95.jpg"
Const urlImgT As String = "http://i65.tinypic.com/jshztc.jpg"

Public Sub fncOnAction(control As IRibbonControl)
On Error GoTo trataErro

    Dim strArquivo As String
    Dim strLocal As String
    Dim strAssunto As String
    Dim strCorpo As String
    Dim objOut As Object
    Dim objmail As Object
    Dim objAnexo As Object
    Dim bytResposta As Byte
    Dim objRS As DAO.Recordset
    
    If TempVars("Email").Value = "" Then
        Call MsgBox("Cliente não possui e-mail informado no cadastro.", vbCritical, "Email")
        Exit Sub
    End If
    
    strArquivo = "info_" & TempVars("NumeroProc").Value & ".pdf"
    strLocal = CurrentProject.Path & "\" & strArquivo
    
    If Len(Nz(Dir(strLocal, vbArchive), "")) > 0 Then Call FileSystem.Kill(strLocal)
    
    Call DoCmd.OutputTo(acOutputReport, "Movimentação Processual", acFormatPDF, strLocal)
    
    Set objOut = CreateObject("Outlook.application")
    Set objmail = objOut.CreateItem(olMailItem)
    Set objAnexo = objmail.Attachments
    
    Call objAnexo.Add(strLocal, olByValue, 1)
    
     strAssunto = "Movimentação Processual " & TempVars("NumeroProc").Value
        strCorpo = "<html><body><b><font style='FONT-SIZE: 12px' color='#000000' face='Tahoma'>Prezado (a) " & TempVars("NomeCliente").Value
        strCorpo = strCorpo & "<html></b><body><font style='FONT-SIZE: 12px' color='#000000' face='Tahoma'><br><br>Encaminhamos a V. Sa. uma atualização referente ao processo nº " & TempVars("NumeroProc").Value
        strCorpo = strCorpo & "<html><body><br><br><b>Essa é uma mensagem gerada automaticamente pelo sistema push de [Soldi Hamann Advocacia].</b><br>Em caso de dúvidas, entre em contato conosco.<br>"
        strCorpo = strCorpo & "<br><img src=" & urlImg & " height=205 width=380><br>"
        strCorpo = strCorpo & "<html><body><br><br><br><font style='FONT-SIZE: 9px' color='#9F9F9F' face='Arial Narrow'><br>AVISO LEGAL   |  Esta mensagem é destinada exclusivamente para a(s) pessoa(s) a quem é dirigida, podendo conter informação confidencial e/ou legalmente privilegiada. Se você não for destinatário desta mensagem, desde já fica notificado de abster-se a divulgar, copiar, distribuir, examinar ou, de qualquer forma, utilizar a informação contida nesta mensagem, por ser ilegal. Caso você tenha recebido esta mensagem por engano, pedimos que nos retorne este E-Mail, promovendo, desde logo, a eliminação do seu conteúdo em sua base de dados, registros ou sistema de controle. Fica desprovida de eficácia e validade a mensagem que contiver vínculos obrigacionais, expedida por quem não detenha poderes de representação."
        strCorpo = strCorpo & "<html><body><font style='FONT-SIZE: 9px' color='#9F9F9F' face='Arial Narrow'><br>LEGAL ADVICE  |  This message is exclusively destined for the people to whom it is directed, and it can bear private and/or legally exceptional information. If you are not addressee of this message, since now you are advised to not release, copy, distribute, check or, otherwise, use the information contained in this message, because it is illegal. If you received this message by mistake, we ask you to return this email, making possible, as soon as possible, the elimination of its contents of your database, registrations or controls system. The message that bears any mandatory links, issued by someone who has no representation powers, shall be null or void."
    
    objmail.To = TempVars("Email").Value
    objmail.Subject = strAssunto
    objmail.HTMLBody = strCorpo
    Call objmail.Send
    
    Call CurrentDb.Execute("update processo set movimentou = 0 where NumProc = """ & TempVars("NumeroProc").Value & """;")
    
sair:
    If Len(Nz(Dir(strLocal, vbArchive), "")) > 0 Then Call FileSystem.Kill(strLocal)
    Set objAnexo = Nothing
    Set objmail = Nothing
    Set objOut = Nothing
    Exit Sub
    
trataErro:
    If Err.Number = 2501 Then
        Call MsgBox("Processo sem movimentação.", vbCritical, "Movimentação")
    Else
        Call MsgBox(Err.Description, vbCritical, "Erro número: " & Err.Number)
    End If
    
    Resume sair
    
End Sub

Public Function fncEnviarEmails(Optional booAutomatico As Boolean = False)
On Error GoTo trataErroGeral

    Dim bytResposta As Byte
    Dim intTotProcessos As Integer
    Dim intContador As Integer
    Dim strArquivo As String
    Dim strLocal As String
    Dim strAssunto As String
    Dim strCorpo As String
    Dim objOut As Object
    Dim objmail As Object
    Dim objAnexo As Object
    Dim objRS As DAO.Recordset
    
    If booAutomatico Then
        bytResposta = vbYes
    Else
        Call Beep
        bytResposta = MsgBox("Deseja enviar apenas processos com novas movimentações registradas?", vbYesNoCancel + vbQuestion + vbDefaultButton3, "Envio...")
        If bytResposta = vbCancel Then Exit Function
    End If
    
    Set objRS = CurrentDb.OpenRecordset("select distinct NumProc from (clientes INNER JOIN processo ON clientes.NumCliente = processo.NumCliente) INNER JOIN movimento ON processo.NumProc = movimento.processo" & IIf(bytResposta = vbYes, " where movimentou = -1", ""))
    
    If Not objRS.EOF Then
        Call objRS.MoveLast: Call objRS.MoveFirst
        intTotProcessos = objRS.RecordCount
    End If
    
    Call objRS.Close: Set objRS = Nothing
    
    'intTotProcessos = DCount("*", "processo", IIf(bytResposta = vbYes, "movimentou = -1", ""))
    
    If bytResposta = vbYes And intTotProcessos = 0 Then
        If Not booAutomatico Then Call MsgBox("Não há processos com novas movimentações registradas.", vbInformation, "Informação")
        Exit Function
    End If
    
    Call DoCmd.OpenForm("frmBarra", OpenArgs:=intTotProcessos)
    Call Form_frmBarra.fncAtualizaBarra(intContador, "Enviando emails...")
    
    Set objOut = CreateObject("Outlook.application")
    Set objRS = CurrentDb.OpenRecordset("select distinct NumProc, movimentou, [e-mail], nome, processo.numCliente from (clientes INNER JOIN processo ON clientes.NumCliente = processo.NumCliente) INNER JOIN movimento ON processo.NumProc = movimento.processo" & IIf(bytResposta = vbYes, " where movimentou = -1;", ";"))
    
    For intContador = 1 To intTotProcessos
    
        Call Form_frmBarra.fncAtualizaBarra(intContador, "Enviando email (" & intContador & "/" & intTotProcessos & ")")
    
        strArquivo = "info_" & objRS("NumProc").Value & ".pdf"
        strLocal = CurrentProject.Path & "\" & strArquivo
        
        If Len(Nz(Dir(strLocal, vbArchive), "")) > 0 Then Call FileSystem.Kill(strLocal)
        
        Call TempVars.Remove("NumeroProc")
        Call TempVars.Add("NumeroProc", objRS("NumProc").Value)
        
        If Nz(objRS("e-mail").Value) = "" Then
            
            If Not booAutomatico Then Call MsgBox("Cliente não possui email informado no cadastro." & vbNewLine & _
                                                  vbNewLine & _
                                                  "NumCliente: " & objRS("numCliente").Value & vbNewLine & _
                                                  "Nome: " & objRS("Nome").Value, vbExclamation, "Atenção !!!")
            
            GoTo trataErroEmail
        
        End If

        On Error GoTo trataErroEmail
        Call DoCmd.OpenReport("Movimentação Processual", acViewPreview, , "cpProcesso = """ & objRS("NumProc").Value & """", acHidden, "1")
        Call DoCmd.OutputTo(acOutputReport, "Movimentação Processual", acFormatPDF, strLocal)
        Call DoCmd.Close(acReport, "Movimentação Processual")
        
        Set objmail = objOut.CreateItem(olMailItem)
        Set objAnexo = objmail.Attachments
        
        Call objAnexo.Add(strLocal, olByValue, 1)
        
        strAssunto = "Movimentação Processual " & objRS("NumProc").Value
        strCorpo = "<html><body><b><font style='FONT-SIZE: 12px' color='#000000' face='Tahoma'>Prezado (a) " & objRS("Nome").Value
        strCorpo = strCorpo & "<html><body></b><font style='FONT-SIZE: 12px' color='#000000' face='Tahoma'><br><br>Encaminhamos a V. Sa. uma atualização referente ao processo nº " & objRS("NumProc").Value
        strCorpo = strCorpo & "<html><body><br><br><b>Essa é uma mensagem gerada automaticamente pelo sistema push de [Soldi Hamann Advocacia].</b><br>Em caso de dúvidas, entre em contato conosco.<br>"
        strCorpo = strCorpo & "<br><img src=" & urlImg & " height=205 width=380><br>"
        strCorpo = strCorpo & "<html><body><br><br><br><font style='FONT-SIZE: 9px' color='#9F9F9F' face='Arial Narrow'><br>AVISO LEGAL   |  Esta mensagem é destinada exclusivamente para a(s) pessoa(s) a quem é dirigida, podendo conter informação confidencial e/ou legalmente privilegiada. Se você não for destinatário desta mensagem, desde já fica notificado de abster-se a divulgar, copiar, distribuir, examinar ou, de qualquer forma, utilizar a informação contida nesta mensagem, por ser ilegal. Caso você tenha recebido esta mensagem por engano, pedimos que nos retorne este E-Mail, promovendo, desde logo, a eliminação do seu conteúdo em sua base de dados, registros ou sistema de controle. Fica desprovida de eficácia e validade a mensagem que contiver vínculos obrigacionais, expedida por quem não detenha poderes de representação."
        strCorpo = strCorpo & "<html><body><font style='FONT-SIZE: 9px' color='#9F9F9F' face='Arial Narrow'><br>LEGAL ADVICE  |  This message is exclusively destined for the people to whom it is directed, and it can bear private and/or legally exceptional information. If you are not addressee of this message, since now you are advised to not release, copy, distribute, check or, otherwise, use the information contained in this message, because it is illegal. If you received this message by mistake, we ask you to return this email, making possible, as soon as possible, the elimination of its contents of your database, registrations or controls system. The message that bears any mandatory links, issued by someone who has no representation powers, shall be null or void."
    
        objmail.To = objRS("e-mail").Value
        objmail.Subject = strAssunto
        objmail.HTMLBody = strCorpo
        Call objmail.Send
        
        Call CurrentDb.Execute("update processo set movimentou = 0 where NumProc = """ & objRS("NumProc").Value & """;")
        
trataErroEmail:
        If Len(Nz(Dir(strLocal, vbArchive), "")) > 0 Then Call FileSystem.Kill(strLocal)
        Set objAnexo = Nothing
        Set objmail = Nothing
        
        On Error GoTo trataErroGeral
        Call objRS.MoveNext
    
    Next intContador
    
sair:
    On Error Resume Next
    Call DoCmd.Close(acForm, "frmBarra", acSaveNo)
    Call objRS.Close: Set objRS = Nothing
    Set objOut = Nothing
    Exit Function
    
trataErroGeral:
    Call MsgBox(Err.Description, vbCritical, "Erro número: " & Err.Number)
    Resume sair

End Function

Public Function fncMacroNaAbertura() As Boolean

    fncMacroNaAbertura = Not (MsgBoxTimer(10, "Deseja executar a macro de envio automático?", vbQuestion + vbYesNo + vbDefaultButton1, "Envio...") = vbNo)

End Function

Private Function MsgBoxTimer(Seconds As Integer, Prompt As String, _
Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
Optional Title As String) As VbMsgBoxResult

    Call Beep
    MsgBoxTimer = CreateObject("WScript.Shell").PopUp(Prompt, Seconds, Title, Buttons)
    
End Function

Código:


Public Function fncAgendaHojeData()


  Dim strline, strHTML

  Dim OL As Outlook.Application
  Dim MyItem As Outlook.MailItem
  
  Dim strCorpo1 As String
  Dim strCorpo2 As String

  Set OL = New Outlook.Application
  Set MyItem = Outlook.Application.CreateItem(olMailItem)
  
  DoCmd.OutputTo acOutputReport, "AgendaHojeData", acFormatHTML, "F:\AgendaHoje.html"
  
  Open "F:\AgendaHoje.html" For Input As 1
  Do While Not EOF(1)
    Input #1, strline
    strHTML = strHTML & strline
    strCorpo1 = "<html><body><br><img src=" & urlImgT & " height=81 width=614><br>"
    strCorpo2 = "<html><body><font style='FONT-SIZE: 10px' color='#9F9F9F' face='Tahoma'><br><br><b>Essa é uma mensagem gerada automaticamente pelo sistema push de [Soldi Hamann Advocacia].</b> Em caso de dúvidas, entre em contato conosco.<br>"
    
  Loop
  Close 1
 ' If OL2002 set the BodyFormat
 ' If Left(OL.Version, 2) = "10" Then
 '   MyItem.BodyFormat = olFormatHTML
'  End If
  
  MyItem.HTMLBody = strCorpo1 & strHTML
  MyItem.Display
  MyItem.To = "annasoldih@gmail.com"
  MyItem.Subject = "agenda @soldihamann"

Call MyItem.Send
    

End Function

Código:



Boa Noite.

Prezado (a) Anna Teste
Encaminhamos a V. Sa. uma atualização referente ao processo nº  00000000002

------------------------------------------------------------------------------------------------
Essa é uma mensagem gerada automaticamente pelo sistema push de [Soldi Hamann Advocacia].
Em caso de dúvidas, entre em contato conosco.
AVISO LEGAL  |  Esta mensagem é destinada exclusivamente para a(s) pessoa(s) a quem é dirigida, podendo conter informação confidencial e/ou legalmente privilegiada. Se você não for destinatário desta mensagem, desde já fica notificado de abster-se a divulgar, copiar, distribuir, examinar ou, de qualquer forma, utilizar a informação contida nesta mensagem, por ser ilegal. Caso você tenha recebido esta mensagem por engano, pedimos que nos retorne este E-Mail, promovendo, desde logo, a eliminação do seu conteúdo em sua base de dados, registros ou sistema de controle. Fica desprovida de eficácia e validade a mensagem que contiver vínculos obrigacionais, expedida por quem não detenha poderes de representação.

LEGAL ADVICE |  This message is exclusively destined for the people to whom it is directed, and it can bear private and/or legally exceptional information. If you are not addressee of this message, since now you are advised to not release, copy, distribute, check or, otherwise, use the information contained in this message, because it is illegal. If you received this message by mistake, we ask you to return this email, making possible, as soon as possible, the elimination of its contents of your database, registrations or controls system. The message that bears any mandatory links, issued by someone who has no representation powers, shall be null or void.




Olá

neste meu artigo (na parte final) tem uma função (fncLerArquivo) que permite gerar o relatório no corpo do e-mail:

usandoaccess.com.br/dicas/outlook-anexos-richtext-account.asp?id=1&idlista=18#inicio
Copiar link e colar no navegador.

Bom estudo!