[Resolvido]Filtrar Relatório Através de Recordset

Bom dia, amigos

Tenho um form de envio de emails através de recordset. Seleciono os registros, faz-se um recordset e envio e-mails para os selecionados.

Agora estou tentando anexar um relatório pdf junto ao e-mail, mas estou tendo problemas ao gerar o filtro.

Tentei:

DoCmd.OpenReport strDocName, acViewPreview, acHidden, , rs!nCONTRATO (obtendo erro "a expressão no argumento 5 apresenta um valor inválido"

ou

DoCmd.OpenReport strDocName, acViewPreview, acHidden, , ncontrato = rs!nCONTRATO (obtenho erro "argumento ou chamada de procedimento inválida")

Tentei também definir uma variável:

strFilter = nCONTRATO = " & rs!nCONTRATO"
ou
strFilter = nCONTRATO = rs!nCONTRATO

DoCmd.OpenReport strDocName, acViewPreview, acHidden, , strfilter (obtenho erro "tipos incompatíveis")


Alguém poderia me dar um auxílio? Estou quebrando a cabeça e não estou conseguindo resolver...
Agradeço a atenção.

Saudações!

Observe se o recordset já esta filtrado com este contrato que deseja para o filtro.
para localizar o registro no recordset

Rs.FindFirst "nCONTRATO = " & Me.CampoNoForm""


Crie uma variável para receber o registro do recordset.

Dim StrTemp as Double (se o campo form numérico) ou Interger.. dependendo do tipo do campo
StrTemp = rs!nCONTRATO


no botão do relatório:

Private Sub btnRelatorio_Click()
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = " NomedoRelatório"
stLinkCriteria = "[nCONTRATO]=" & StrTemp
DoCmd.OpenReport stDocName, acViewPreview, , stLinkCriteria

End Sub

Cumprimentos

Bom dia, Harysohn!

Obrigado pela resposta.

Bom, como a estrutura de meu código é diferente, adaptei as partes das variáveis sem a parte do Recordset como você sugeriu, já que a mesma já existe. Só que agora obtenho um erro: "Erro em tempo de execução "91": A variável do objeto ou a variável do bloco 'With' não foi definida." Ao abrir a depuração, a linha StrTemp = rs!nCONTRATO aparece destacada.

Este campo nCONTRATO é texto, apesar de ser um número de contrato (já tentei mudar para número mas tenho muitas funções em outras partes do projeto que solicitam como texto) - mas tanto Integer quanto Double dá o mesmo erro.

Estou postando o código completo para você poder ver a estrutura.

Saudações!

Código:

Private Sub Comando20_Click()

Dim strArquivo  As String
Dim strLocal    As String
Dim objOut      As Object
Dim objMail    As Object
Dim objAnexo    As Object
Dim strDocName As String
Dim strFilter As String
Dim outapp As Object
Dim outmail As Object

Const olMailItem = 0
Const olByValue = 1

Dim StrEnviados As String
Dim rsEnviados As DAO.Recordset
Dim rs As DAO.Recordset
Dim N As Double
Dim db As DAO.Database
Dim ws As DAO.Workspace

Dim StrTemp As Integer
StrTemp = rs!nCONTRATO
strDocName = "qry_email"

Dim stLinkCriteria As String
stLinkCriteria = "[nCONTRATO]=" & StrTemp

'---------------------------------------

Set ws = DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase("p:\backend\editoracao_be.accdb", False, _
    False, "MS Access;PWD=senha")

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 ser possível o envio do email.", vbInformation, "Aviso"
        Exit Sub
    End If
End If
'---------------------------------------
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_index WHERE Selecionado = -1")

If rs.RecordCount = 0 Then
MsgBox "Não existe e-mail selecionado", vbInformation, "Atenção"
Exit Sub
Else

Do While Not rs.EOF
'---------------------------------------
Set outapp = CreateObject("Outlook.application")
outapp.session.logon

Set outmail = outapp.CreateItem(olMailItem)
With outmail
.To = "" & rs!EMAIL & ""
.Subject = "Aprovação de Anúncio Contratado - Ct. " & rs!nCONTRATO & " - " & rs!FANTASIA

'---------------------------------------
.htmlbody = ""
'---------------------------------------

Set objAnexo = outmail.Attachments

strArquivo = "" & rs!nCONTRATO & ".pdf"
strLocal = "p:\Enviados\" & strArquivo

If Me.Dirty Then DoCmd.RunCommand acCmdSaveRecord

DoCmd.OpenReport strDocName, acViewPreview, , stLinkCriteria

DoCmd.OutputTo acOutputReport, "qry_email", acFormatPDF, strLocal, acExportQualityPrint

DoCmd.Close acReport, "qry_email"

objAnexo.Add strLocal, olByValue, 1

.Save
'---------------------------------------

 StrEnviados = ("SELECT * FROM tbl_Enviados")

    Set rsEnviados = db.OpenRecordset(StrEnviados)
      rsEnviados.AddNew
   
rsEnviados![cliente] = rs!FANTASIA
rsEnviados![para] = rs!EMAIL
rsEnviados![nCONTRATO] = rs!nCONTRATO
rsEnviados![usuario] = Forms!form_index!txtUser
rsEnviados![tipo_email] = "Envio de Layout"

rsEnviados.Update


rs.MoveNext
 
End With

Loop

db.Execute "UPDATE tbl_index SET Selecionado=0 WHERE Selecionado = -1;"

 Me.Requery
 Me.Refresh

'---------------------------------------

MsgBox "Os e-mails para os contratos selecionados foram enviados para a caixa de saída do Outlook.", vbOKOnly + vbInformation, "Aviso"
Set rs = Nothing
Set db = Nothing
Set objAnexo = Nothing
Set objMail = Nothing
Set objOut = Nothing

ws.Close

End If
End Sub

Esse erro aconteceu porque voce tentou carregar a variável antes de setar o recordset...
Aplique esta função: StrTemp = rs!nCONTRATO

Após o Set do recordset

Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_index WHERE Selecionado = -1")
StrTemp = rs!nCONTRATO


Mude a variável para String pois informou que o campo é texto.

Cumprimentos

Harysohn

Com seu auxílio, consegui com que fosse gerado o pdf anexo ao e-mail. Tive que mudar alguma coisa devido ao campo ser texto, defini as variáveis e as carreguei após o recordset, na seguinte ordem:

Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_index WHERE Selecionado = -1")
StrTemp = rs!NCONTRATO
stLinkCriteria = "[nCONTRATO]=" & "'" & StrTemp & "'"


Porém, o relatório anexado é sempre o primeiro selecionado - nunca ambos;

Por exemplo: se eu selecionar os contratos 0055 e 0060, terei os dois e-mails dos respectivos contratos, porém ambos terão o contrato do 0055 em anexo.

Se a variável do linkcriteria está após o recordset, isto deveria ocorrer?

Neste caso so abrirá apenas um...

pois a variável so esta armazenando uma ID...

Sim, um relacionado ao contrato;

Quando o loop volta, não refaz o processo? Anexa novamente e tal...?

A solução ai trilha pelo Loop no recordset... Assim

Le o recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_index WHERE Selecionado = -1")

Do (inicia o loop)
StrTemp = rs!NCONTRATO
stLinkCriteria = "[nCONTRATO]=" & "'" & StrTemp & "'"
Envia o email
Rs.Move Next
Loop

Assim a cada loop exporta, e envia.... exporta e envia..

O codigo acima não esta completo.. é so pra exemplificar...

Envie o código completo.

Segue o código:

Código:

Private Sub Comando20_Click()

Dim strArquivo  As String
Dim strLocal    As String
Dim objOut      As Object
Dim objMail    As Object
Dim objAnexo    As Object
Dim strDocName As String
Dim strFilter As String
Dim outapp As Object
Dim outmail As Object

Const olMailItem = 0
Const olByValue = 1

Dim StrEnviados As String
Dim rsEnviados As DAO.Recordset
Dim rs As DAO.Recordset
Dim N As Double
Dim db As DAO.Database
Dim ws As DAO.Workspace

Dim StrTemp As String
Dim stLinkCriteria As String

strDocName = "qry_email"


'---------------------------------------

Set ws = DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase("p:\backend\editoracao_be.accdb", False, _
    False, "MS Access;PWD=senha")

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 ser possível o envio do email.", vbInformation, "Aviso"
        Exit Sub
    End If
End If
'---------------------------------------
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_index WHERE Selecionado = -1")
StrTemp = rs!nCONTRATO
stLinkCriteria = "[nCONTRATO]=" & "'" & StrTemp & "'"

If rs.RecordCount = 0 Then
MsgBox "Não existe e-mail selecionado", vbInformation, "Atenção"
Exit Sub
Else

Do While Not rs.EOF
'---------------------------------------
Set outapp = CreateObject("Outlook.application")
outapp.session.logon

Set outmail = outapp.CreateItem(olMailItem)
With outmail
.To = "" & rs!EMAIL & ""
.Subject = "Aprovação de Anúncio Contratado - Ct. " & rs!nCONTRATO & " - " & rs!FANTASIA

'---------------------------------------
'.htmlbody = ""
'---------------------------------------

Set objAnexo = outmail.Attachments

strArquivo = "" & rs!nCONTRATO & ".pdf"
strLocal = "p:\Enviados\" & strArquivo

If Me.Dirty Then DoCmd.RunCommand acCmdSaveRecord

DoCmd.OpenReport strDocName, acViewPreview, , stLinkCriteria

DoCmd.OutputTo acOutputReport, "qry_email", acFormatPDF, strLocal, acExportQualityPrint

DoCmd.Close acReport, "qry_email"

objAnexo.Add strLocal, olByValue, 1

.Save
'---------------------------------------

 StrEnviados = ("SELECT * FROM tbl_Enviados")

    Set rsEnviados = db.OpenRecordset(StrEnviados)
      rsEnviados.AddNew
   
rsEnviados![cliente] = rs!FANTASIA
rsEnviados![para] = rs!EMAIL
rsEnviados![nCONTRATO] = rs!nCONTRATO
rsEnviados![usuario] = Forms!form_index!txtUser
rsEnviados![tipo_email] = "Envio de Layout"

rsEnviados.Update


rs.MoveNext
 
End With

Loop

db.Execute "UPDATE tbl_index SET Selecionado=0 WHERE Selecionado = -1;"

 Me.Requery
 Me.Refresh

'---------------------------------------

MsgBox "Os e-mails para os contratos selecionados foram enviados para a caixa de saída do Outlook.", vbOKOnly + vbInformation, "Editoração EBGE RIO"
Set rs = Nothing
Set db = Nothing
Set objAnexo = Nothing
Set objMail = Nothing
Set objOut = Nothing

ws.Close

End If
End Sub




Me envie em um arquito texto (.txt) ou doc

Estas linhas tem que estarem dentro do loop

StrTemp = rs!nCONTRATO
stLinkCriteria = "[nCONTRATO]=" & "'" & StrTemp & "'"
DoCmd.OpenReport strDocName, acViewPreview, , stLinkCriteria

Mais ou menos nessa sequencia.. antes da linha em azul no código.

Harysohn

Consegui, enfim, resolver após a reordenação das linhas, como segue abaixo.

Ótima lição. Muitíssimo obrigado pela força.

Saudações!

Código:

Private Sub Comando20_Click()

Dim strArquivo  As String
Dim strLocal    As String
Dim objOut      As Object
Dim objMail    As Object
Dim objAnexo    As Object
Dim strDocName As String
Dim strFilter As String
Dim outapp As Object
Dim outmail As Object

Const olMailItem = 0
Const olByValue = 1

Dim StrEnviados As String
Dim rsEnviados As DAO.Recordset
Dim rs As DAO.Recordset
Dim N As Double
Dim db As DAO.Database
Dim ws As DAO.Workspace

Dim StrTemp As String
Dim stLinkCriteria As String

strDocName = "qry_email"


'---------------------------------------

Set ws = DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase("p:\backend\editoracao_be.accdb", False, _
    False, "MS Access;PWD=senha")

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 ser possível o envio do email.", vbInformation, "Aviso"
        Exit Sub
    End If
End If
'---------------------------------------
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_index WHERE Selecionado = -1")

If rs.RecordCount = 0 Then
MsgBox "Não existe e-mail selecionado", vbInformation, "Atenção"
Exit Sub
Else

Do While Not rs.EOF
'---------------------------------------

Set outapp = CreateObject("Outlook.application")
outapp.session.logon

Set outmail = outapp.CreateItem(olMailItem)
With outmail
.To = "" & rs!EMAIL & ""
.Subject = "Aprovação - Ct. " & rs!nCONTRATO & " - " & rs!FANTASIA

'---------------------------------------
outmail.htmlbody = ""
'---------------------------------------

Set objAnexo = outmail.Attachments

strArquivo = "" & rs!nCONTRATO & ".pdf"
strLocal = "p:\Enviados\" & strArquivo

If Me.Dirty Then DoCmd.RunCommand acCmdSaveRecord


StrTemp = rs!nCONTRATO
stLinkCriteria = "[nCONTRATO]=" & "'" & StrTemp & "'"
DoCmd.OpenReport strDocName, acViewPreview, , stLinkCriteria

DoCmd.OutputTo acOutputReport, "qry_email", acFormatPDF, strLocal, acExportQualityPrint

DoCmd.Close acReport, "qry_email"

objAnexo.Add strLocal, olByValue, 1

.Send
'---------------------------------------

 StrEnviados = ("SELECT * FROM tbl_Enviados")

    Set rsEnviados = db.OpenRecordset(StrEnviados)
      rsEnviados.AddNew
   
rsEnviados![cliente] = rs!FANTASIA
rsEnviados![para] = rs!EMAIL
rsEnviados![nCONTRATO] = rs!nCONTRATO
rsEnviados![usuario] = Forms!form_index!txtUser
rsEnviados![tipo_email] = "Envio de E-mail"

rsEnviados.Update


rs.MoveNext
 
End With

Loop

db.Execute "UPDATE tbl_index SET Selecionado=0 WHERE Selecionado = -1;"

 Me.Requery
 Me.Refresh

'---------------------------------------

MsgBox "Os e-mails para os contratos selecionados foram enviados para a caixa de saída do Outlook.", vbOKOnly + vbInformation, "Aviso"
Set rs = Nothing
Set db = Nothing
Set objAnexo = Nothing
Set objMail = Nothing
Set objOut = Nothing

ws.Close

End If
End Sub


O Fórum agradece o Retorno.