[Resolvido]Envio de Emails Semanais com Relatório Filtrado

Boa tarde galera

Preciso que no meu BD toda semana seja enviado um relatorio de um grupo especifico para um email atribuido ao grupo.
Estou tentando adaptar o código do Avelino (http://www.usandoaccess.com.br/tutoriais/tuto12.asp?id=1#inicio) mas não estou conseguindo me acertar com o loop.
O código que cheguei é o seguinte:

Dim RS As DAO.Recordset
Dim Email As String
Dim corpo As String

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

If IsNull(Me!GRUPO) Then Exit Sub

'---------------------------------------------
'Carregando a coleção do Outlook
'Similar ao abrir o Outlook
'---------------------------------------------
Set objOut = CreateObject("Outlook.application")

'------------------------------------------------------------
'Abrindo o formulário de email para inserir os itens de email
'Similar ao clicar no botão NOVO do Outlook
'------------------------------------------------------------
Set objmail = objOut.CreateItem(olMailItem)

'------------------------------------------------------------
'Abrindo a opção anexo
'Similar ao clicar no botão ANEXO do Outlook
'------------------------------------------------------------
Set objAnexo = objmail.attachments

Set RS = CurrentDb.OpenRecordset("tbemail")

Dim db As Database
Dim regt As Recordset
Dim index As String
Dim iduser As Integer

'Salvando alterações no registro
If Me.Dirty Then DoCmd.RunCommand acCmdSaveRecord

'---------------------------------------------------------------------------------
'Indico o nome do arquivo pdf e o local que será gravado
'O local que escolhi para gravar os arquivos de pdf gerados
'é na pasta enviados, aonde se encontra o aplicativo.
'Neste exemplo, gero os nomes dos arquivos, aproveitando o número exclusivo
'do cliente. Então os arquivos vão ficar com o aspecto: rlt1.pdf, rlt2.pdf, ...
'É claro que vc poderá gerar o nome que achar mais conveniente.
'---------------------------------------------------------------------------------
strArquivo = "status semanal - " & Me.GRUPO & ".pdf"
strLocal = CurrentProject.Path & "\enviados\" & strArquivo

DoCmd.GoToRecord , , acFirst

Do While Not RS.EOF

'----------------------------------------------------------------------------
'Abre o relatório filtrado e oculto de acordo com o cliente selecionado.
'----------------------------------------------------------------------------
DoCmd.OpenReport "status", acViewPreview, , "cliente = '" & Me!GRUPO & "'", acHidden

'----------------------------------------------------------------------------------------
'gero o pdf do relatório através do comando outputto.
'o mecanismo do Access reconhece que o relatório solicitado pelo outputto já está aberto
'e então o outputto usará o relatório já aberto e filtrado.
'-----------------------------------------------------------------------------------------
DoCmd.OutputTo acOutputReport, "status", acFormatPDF, strLocal

'-------------------------------------------
'fecha o relatório clientes que está oculto
'-------------------------------------------
DoCmd.Close acReport, "status"

'--------------------------------------------------------
'adiciona o arquivo pdf no anexo
'-------------------------------------------------------

Email = RS("email")

ObjAnexo.Add strLocal, olByValue, 1
objmail.to = Email
objmail.subject = "STATUS SEMANAL DE PROCESSOS"

'-----------------------------------------------------------------
'Mostra a tela de sáida de email que abrimos
'-----------------------------------------------------------------
objmail.send

Set db = CurrentDb()
Set regt = db.OpenRecordset("tbemail", dbOpenTable)
regt.index = "iduser"
regt.Seek "=", iduser
DoCmd.GoToControl "status"
Me.STATUS.SetFocus
Me.STATUS = Date

End If


Set objAnexo = Nothing
Set objmail = Nothing

RS.MoveNext
Loop

RS.Close
Set objAnexo = Nothing
Set objmail = Nothing
Set objOut = Nothing
Set RS = Nothing

'-------------------------------------------------------
'Tudo já foi entregue ao outlook, então podemos esvaziar
'a memoria do computador usada pelas variáveis
'-------------------------------------------------------

End Sub


---O primeiro email é enviado corretamente, já no segundo dá erro na linha

objAnexo.Add strLocal, olByValue, 1


Segue em anexo o BD para melhor entendimento.
Agradeço desde já.

Olá,

Bom, eu não pude testar porque não tenho o Outlook instalado.
Mas parece que está fechando os objetos dentro do loop:

Set objAnexo = Nothing
Set objmail = Nothing

RS.MoveNext
Loop

Como já estão sendo fechados depois do loop, onde é o correto, pode (aliás, deve) excluir as duas primeiras linhas acima:
Set objAnexo = Nothing
Set objmail = Nothing

Claudio, obrigada pelo retorno, mas mesmo removendo as linhas do fechamento, ele continua dando erro
na mesma linha objAnexo.Add strLocal, olByValue, 1

Caroline, desculpe por não poder ajudar.
Sem o Outlook, não tenho como testar o código.

Tente passar as linhas abaixo para dentro do loop, logo após a linha "Do While..."

Set objmail = objOut.CreateItem(olMailItem)
Set objAnexo = objmail.attachments

e deixando aquelas linhas onde estavam originalmente:

Set objAnexo = Nothing
Set objmail = Nothing
RS.MoveNext
Loop

Consegui acertar o código a partir da ajuda do Cláudio.
Segue o código final que gera os relatórios filtrados e envia para o email atribuido ao grupo.


Private Sub sendemail_Click()

Dim RS As DAO.Recordset
Dim Email As String
Dim corpo As String

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

If IsNull(Me!GRUPO) Then Exit Sub

Dim db As Database
Dim regt As Recordset
Dim index As String
Dim iduser As Integer

'Salvando alterações no registro
If Me.Dirty Then DoCmd.RunCommand acCmdSaveRecord

Set RS = CurrentDb.OpenRecordset("tbemail")

DoCmd.GoToRecord , , acFirst

Do While Not RS.EOF

'---------------------------------------------------------------------------------
'Indico o nome do arquivo pdf e o local que será gravado
'O local que escolhi para gravar os arquivos de pdf gerados
'é na pasta enviados, aonde se encontra o aplicativo.
'Neste exemplo, gero os nomes dos arquivos, aproveitando o número exclusivo
'do cliente. Então os arquivos vão ficar com o aspecto: rlt1.pdf, rlt2.pdf, ...
'É claro que vc poderá gerar o nome que achar mais conveniente.
'---------------------------------------------------------------------------------
strArquivo = "status semanal - " & Me.GRUPO & ".pdf"
strLocal = CurrentProject.Path & "\enviados\" & strArquivo

'---------------------------------------------
'Carregando a coleção do Outlook
'Similar ao abrir o Outlook
'---------------------------------------------
Set objOut = CreateObject("Outlook.application")

'------------------------------------------------------------
'Abrindo o formulário de email para inserir os itens de email
'Similar ao clicar no botão NOVO do Outlook
'------------------------------------------------------------
Set objmail = objOut.CreateItem(olMailItem)

'------------------------------------------------------------
'Abrindo a opção anexo
'Similar ao clicar no botão ANEXO do Outlook
'------------------------------------------------------------
Set objAnexo = objmail.attachments

'----------------------------------------------------------------------------
'Abre o relatório filtrado e oculto de acordo com o cliente selecionado.
'----------------------------------------------------------------------------
DoCmd.OpenReport "status", acViewPreview, , "cliente = '" & Me!GRUPO & "'", acHidden

'----------------------------------------------------------------------------------------
'gero o pdf do relatório através do comando outputto.
'o mecanismo do Access reconhece que o relatório solicitado pelo outputto já está aberto
'e então o outputto usará o relatório já aberto e filtrado.
'-----------------------------------------------------------------------------------------
DoCmd.OutputTo acOutputReport, "status", acFormatPDF, strLocal

'-------------------------------------------
'fecha o relatório clientes que está oculto
'-------------------------------------------
DoCmd.Close acReport, "status"

'--------------------------------------------------------
'adiciona o arquivo pdf no anexo
'-------------------------------------------------------

Email = RS("email")

objAnexo.Add strLocal, olByValue, 1
objmail.to = Email
objmail.subject = "STATUS SEMANAL DE PROCESSOS"

'-----------------------------------------------------------------
'Mostra a tela de sáida de email que abrimos
'-----------------------------------------------------------------
objmail.send

'-----------------------------------------------------------------
'Marcação de STATUS para que em seguida seja colocada a função if e os emails não sejam enviados repetidos
'-----------------------------------------------------------------

Set db = CurrentDb()
Set regt = db.OpenRecordset("tbemail", dbOpenTable)
regt.index = "iduser"
regt.Seek "=", iduser
DoCmd.GoToControl "status"
Me.STATUS.SetFocus
Me.STATUS = Date

'-----------------------------------------------------------------
'Esvazio a memória para que ele possa gerar o relatório do grupo seguinte
'-----------------------------------------------------------------

Set objAnexo = Nothing
Set objmail = Nothing

DoCmd.GoToRecord , , acNext

RS.MoveNext
Loop

RS.Close

'-------------------------------------------------------
'Tudo já foi entregue ao outlook, então podemos esvaziar
'a memoria do computador usada pelas variáveis
'-------------------------------------------------------
Set objOut = Nothing
Set RS = Nothing

End Sub