[Resolvido]Obter vários registros em tabela e enviando por e-mail no outlook

Boa tarde, amigos de Acess

Mais uma vez venho solicitar um auxílio neste ótimo fórum.

Seguinte: Tenho um subformulário que possui vários registros vinculados ao formulário principal.
Estou configurando um email de confirmação que obtém dados destes formulários, da seguinte forma:

Set objMail = objOut.createitem(olMailItem)
objMail.To = "" & [EMAIL] & ""
objMail.Subject = "Confirmação de Pedido - " & [nCONTRATO] & " - " & [FANTASIA]

No corpo do email preciso especificar os registros dos pedidos, mais ou menos assim:

objMail.HTMLBody = "Produtos: _
& vbCrLf & " & [produto] & " _
& vbCrLf & " & [produto] & " _
& vbCrLf & " & [produto] & "

Como faço para especificar TODOS os registros do subformulário relacionados a algum registro específico no formulário principal?


Desde já, meus agradecimentos.

Alguma ideia, amigos?

Tentei pesquisar qual o nome dete tipo de uso, mas não achei nada ainda.

Alguem poderia me sugerir outra forma de fazer isto?

Tente algo assim:

Dim rs As Recordset
Set rs = Currentdb.OpenRecordset("SELECT * FROM NomeTabela WHERE Código=" & Me.Código & ")

Set objMail = objOut.createitem(olMailItem)
objMail.To = "" & [EMAIL] & ""
objMail.Subject = "Confirmação de Pedido - " & [nCONTRATO] & " - " & [FANTASIA]

Do While Not rs.EOF
objMail.HTMLBody = "Produtos: " & vbCrLf & rs!Produto
rs.MoveNext
Loop

rs.Close
Set rs = Nothing

É por aí. Adapte à suas necessidades.

Boa Tarde,

O ideal é você criar uma table HTML e fazer um loop
dos registros do seu subformulário para inserir na table
do corpo do email.

Sds,

Olá, Criquio - muito obrigado pela resposta.

Estou tendo um erro de sintaxe ao adaptar o código - não estou sabendo onde inserir / trocar a ordem das linhas.

Poderia dar uma conferida, por favor?




Private Sub Comando272_Click()

Dim objOut As Object
Dim objMail As Object
Dim rs As Recordset
Const olMailItem = 0
Const olByValue = 1

If IsNull(Me!nCONTRATO) Then Exit Sub

If fncOutlookInstalado = False Then
MsgBox "O Outlook não está instalado.", vbInformation, "Aviso"
Exit Sub
Else
If fncOutlookAberto = False Then
MsgBox "Mantenha o Outlook aberto para o envio do email.", vbInformation, "Aviso"
Exit Sub

End If
End If

Set rs = Currentdb.OpenRecordset("SELECT * FROM tbl_MateriasContratadas WHERE nCONTRATO=" & Me.nCONTRATO & ")
Set objOut = CreateObject("Outlook.application")
Set objMail = objOut.createitem(olMailItem)
objMail.To = "" & [EMAIL] & ""
objMail.Subject = "Confirmação de Pedido - " & [nCONTRATO] & " - " & [FANTASIA]

Do While Not rs.EOF
objMail.HTMLBody = "Produtos: " & vbCrLf & rs!Produto
rs.MoveNext

Loop

rs.Close

objMail.Display

Set rs = Nothing
Set objMail = Nothing
Set objOut = Nothing

End Sub

chsestrem

Estou testando o código que o criquio me passou - mas uma tabela em html seria uma boa, já que o corpo do email é em html também.

Poderia me passar um link de exemplo?

Como disse, não sei o nome desta propriedade.

Obrigado a todos.

Amigão, sempre que ocorrer erros, informe a mensagem de erro exibida e a linha para a qual o vba é depurado para que possamos ter uma melhor ideia do que seja. Podem ocorrer enes erros decorrentes de enes razões.

Sim, sim -

Mensagem de erro que aparece:

Erro de Compilação: Erro de sintaxe

Private Sub Comando272_Click() ------ (em amarelo)

Em vermelho e destaque:

Set rs = Currentdb.OpenRecordset("SELECT * FROM tbl_MateriasContratadas WHERE nCONTRATO=" & Me.nCONTRATO & ")

Código:

'Exemplo para envio de email em forma de Tabela
'By Charles Sestrem
'chsestrem@hotmail.com
'05 de Agosto de 2011

' na declaração Geral
Dim StrDestinatario
Dim StrNomeDest As String
Dim StDocName As String
Dim StrMensagem As String
Dim StImage As String

Private Sub Envia_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim rs As DAO.Recordset
Dim strsql As String
Dim txthtm As String

'Iniciando o Texto com o tratamento de Horário:
   
If Time$ > "12:00:00" Then StrMensagem = "<BR>Boa Tarde " & StrNomeDest & "</BR>" Else StrMensagem = "<BR>Bom dia " & StrNomeDest & "</BR>"
StrMensagem = StrMensagem & "<BR>Segue anexo relatorio de Faturamento. </BR>"
StrMensagem = Chr(13) & StrMensagem & "<BR>Pedimos a gentileza de verificar e nos retornar assim que possivel. </BR>"
StrMensagem = StrMensagem & "<BR></BR>"
StrMensagem = StrMensagem & "<BR>Sds, </BR>"
StrMensagem = StrMensagem & "<BR>Fulano de Tal </BR>" ' Pequeno texto acima e em seguida a Assinatura
StrMensagem = StrMensagem & "<BR>Empresa Modelo Ltda</BR>"
StrMensagem = StrMensagem & "<BR>FulanodeTal@EmpresaModelo.com.br</BR>"

StrDestinatario="Jose das Couves" ' Aqui podemos declarar uma caixa de texto


'Exportar uma tabela Access diretamente para o Corpo do Email

txthtm = "<HTML> "
txthtm = txthtm & "<HEAD>"
txthtm = txthtm & "<TITLE>Criando Tabelas</TITLE>"
txthtm = txthtm & "</HEAD>"
txthtm = txthtm & "<BODY>"
txthtm = txthtm & "<BR>" & StrMensagem & "</BR>"
txthtm = txthtm & "<CENTER><FONT COLOR=BLUE SIZE=3>Tabela de Faturamento</FONT></CENTER>"
txthtm = txthtm & "<BR>"
txthtm = txthtm & "<TABLE BORDER=1> <! Inicia a tabela e coloca uma borda de espessura igual a 1>"
txthtm = txthtm & "<TR bgcolor= ""#CDBE70""><CENTER><TD>Faturamento</TD><TD>Pasta</TD><TD>Vencimento</TD><TD>CTRC</TD>"
txthtm = txthtm & "<TD>Viagem</TD><TD>Motorista</TD><TD>Valor</TD><TD>Atraso</TD><TD>Comentario</TD></CENTER></TR>"
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Tabela")

' Inicia o loop para exibir todos oe registros

Do While Not rs.EOF
txthtm = txthtm & "<TR bgcolor= ""#CFCFCF""><! Cria a primeira linha da tabela>"
txthtm = txthtm & "<TD>" & rs!Campo1 & " </TD> <! Aqui foi criada uma célula>"
txthtm = txthtm & "<TD>" & rs!Campo2 & " </TD>"
txthtm = txthtm & "<TD>" & rs!Campo3 & " </TD>"
txthtm = txthtm & "<TD>" & rs!Campo4 & " </TD>"
txthtm = txthtm & "<TD>" & rs!Campo5 & " </TD>"
txthtm = txthtm & "<TD>" & rs!Campo6 & "</TD>"
txthtm = txthtm & "<TD>" & Format(rs!Campo7, "Currency") & "</TD>"
txthtm = txthtm & "<TD>" & rs!Campo8 & "</TD>"
txthtm = txthtm & "<TD>" & rs!Campo9 & "</TD></TR>"
rs.MoveNext
Loop
txthtm = txthtm & "</TABLE>"
txthtm = txthtm & "<BR>"
txthtm = txthtm & "</BODY>"
txthtm = txthtm & "</HTML>"

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
 
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .To = StrDestinatario ' Variável do Destinatário
    .CC = "EmCopiaParaAlguem@EmpresaModelo.com.br"
    .BCC = "" ' Cópia Oculta
    .Subject = "Relatorio de Faturamento" 'Título da Mensagem
    .htmlbody = txthtm ' Corpo do Email
  '  .Attachments.Add (AlgumArquivo) 'está comentado, você pode habilitar para enviar um arquivo anexo
    .display
   
End With

rs.Close
End Sub


Olá, chsestrem

Seu código funciona perfeitamente com as tabelas em html - muitíssimo obrigado, é exatamente do que preciso!!!

Mas estou em dúvida praticamente na mesma linha de código que o criquio me passou: no comando WHERE

Com a linha Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_MateriasContratadas") funciona perfeitamente, porém aparecem todos os registros.

Estou tentando fazer uso do WHERE, assim:

Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_MateriasContratadas WHERE nCONTRATO=" & Me.nCONTRATO & ")

Mas o que obtenho é um erro:

"Erro de compilação: Era esperado: Separador de lista ou )"

Tentei de outras maneiras, mas nada de funcionar com um filtro.

Alguma sugestão?

...='" & CampoOuVariável & "'"

Isso é para os casos em que usamos um DLookup ou algo do gênero. Se usamos sql, é um pouquinho diferente:

...='" & CampoOuVariável & "' para o meio da instrução e ='" & CampoOuVariável & "';" para o fim da instrução. Quando usamos um campo ou variável com a cláusula WHERE, aí vai depender se o critério é numérico ou texto:

Numérico:
WHERE Código=" & Me.Código & ";"
Texto:
WHERE Nome='" & Me.Nome & "';"

Perfeito, Harysohn!!!

Muito obrigado por me ajudar nessa. Realmente, o campo definido por mim é texto, apesar de ser um campo de código.

Agradeço a todos que me auxiliaram - o código enviado pelo chsestrem funciona muito bem, como eu precisava. Ajustarei às minhas necessidades e me será de muitíssima valia.

Mais uma vez, obrigado. Problema resolvido.

Se puder poste um exemplo no repositório...seria de muita valia..

Saudações

Ok - Postarei sim - vou retirar o desnecessário e logo logo posto aqui!

chsestrem

Pgenado seu código, existe a possibilidade de adicionar um campo total no rodape dessa tabela?

Esse é o código que eu adpatei para as minhas necessidades

Dim OutApp As Object
Dim OutMail As Object
Dim rs As DAO.Recordset
Dim strsql As String
Dim txthtm As String

'Iniciando o Texto com o tratamento de Horário:

If Time$ > "12:00:00" Then StrMensagem = "
Boa Tarde " & StrNomeDest & "
" Else StrMensagem = "
Bom dia " & StrNomeDest & "
"
StrMensagem = StrMensagem & "
Segue a lista de solicitação de compra N° " & numsol & "
"
StrMensagem = Chr(13) & StrMensagem & "
Peço a gentileza de verificar para aprovação.
"
StrMensagem = StrMensagem & "

"
StrMensagem = StrMensagem & "
Sds,
"
StrMensagem = StrMensagem & "
Fabricio Gusmão
" ' Pequeno texto acima e em seguida a Assinatura
StrMensagem = StrMensagem & "
Teuqlay Ltda
"
StrMensagem = StrMensagem & "
fabricio@tequaly.com.br
"

StrDestinatario = "accessmoraes@hotmail.com" ' Aqui podemos declarar uma caixa de texto


'Exportar uma tabela Access diretamente para o Corpo do Email

txthtm = " "
txthtm = txthtm & ""
txthtm = txthtm & ""
txthtm = txthtm & ""
txthtm = txthtm & ""
txthtm = txthtm & "
" & StrMensagem & "
"
txthtm = txthtm & "Lista de materiais SC N° " & numsol & ""
txthtm = txthtm & "
"
txthtm = txthtm & ""
txthtm = txthtm & ""
txthtm = txthtm & ""
Set rs = CurrentDb.OpenRecordset("SELECT * FROM CnsSolicitacao WHERE numsol=" & Me.numsol & "")

' Inicia o loop para exibir todos oe registros
Do While Not rs.EOF
txthtm = txthtm & ""
txthtm = txthtm & ""
txthtm = txthtm & ""
txthtm = txthtm & ""
txthtm = txthtm & ""
txthtm = txthtm & ""
txthtm = txthtm & ""
rs.MoveNext
Loop
txthtm = txthtm & "

Código	Descrição	Un	Quant	R$ Unit.	R$ Total
" & rs!codpro & "	" & rs!cplpro & "	" & rs!unimed & "	" & rs!qtdsol & "	" & Format(rs!presol, "Currency") & "	" & Format(rs!x, "Currency") & "

"
txthtm = txthtm & "
"
txthtm = txthtm & ""
txthtm = txthtm & ""

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = StrDestinatario ' Variável do Destinatário
.cc = ""
.BCC = "" ' Cópia Oculta
.subject = "Solicitação de Compra" 'Título da Mensagem
.htmlbody = txthtm ' Corpo do Email
' .Attachments.Add (AlgumArquivo) 'está comentado, você pode habilitar para enviar um arquivo anexo
.display

End With
rs.Close


Precisa adicionar a soma da coluna total.

Desde já agradeço pela atenção.

up

Resolvido