[Resolvido]Buscar dados em uma tabela e enviar email

Pessoal;

Escrevi um código que busca em  um campo da tabela padrão todos os padrões cujo contador é igual a 1, essa era a ideia, mas não funciona.
Obs. Esse código termina enviando um e-mail, mas essa parte funciona.


Sub EnviaEmai()

Dim appOutlook As Object
Dim olMail As Object
Dim varPadrões As String
Dim rsPadrões As Recordset
Dim varcontrole As Integer

'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0

Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail
Set rsPadrões = CurrentDb.OpenRecordset("tb_Padrões", dbOpenTable)

'varcontrole = 1
varContador = 0

 varPadrões = rsPadrões.Fields("Padrões")

Do While Not rsPadrões.EOF And Not rsPadrões.BOF
   
   varTempo = rsPadrões.Fields("Tempo")
   
    varcontrole = rsPadrões.Fields("Cont")
    If varcontrole = 1 Then
     varPadrões = rsPadrões.Fields("Padrões")
       
 
           varPadrões = [varPadrões] + vbNewLine + rsPadrões.Fields("Padrões")
         
       End If
   
   VarCont = rsPadrões.Fields("Cont")
   varContador = varContador + VarCont
   rsPadrões.MoveNext
 Loop
 
 If varContador > 0 Then
   With olMail
   On Error Resume Next
   .To = "xxxxx@xxx.com.br"
   .Subject = "Padrões Críticos"
   '.Attachments.Add ("Y:xxxxxxxxx.xls")
   '.Attachments.Add = ("C:xxxxxx.xls")
   .Body = "Bom dia," + vbNewLine + "Segue os padrões críticos com trienamento vencido." + vbNewLine + "Os padrões a serem treinados serão:" + vbNewLine + vbNewLine + [varPadrões] + vbNewLine + vbNewLine + "Mensagem Virtual," + vbNewLine + "Célula de Gestão da Metalurgia do Aço" + vbNewLine + "CGA"
    .Send '.Send
   End With
 End If
rsPadrões.Close
End Sub


Alguém pode me ajudar???

Se você quer criar uma consulta dos padrões cujo contador é igual a 1, terá que criar uma variavel tipo Database e outra Recordset.

Dim db as DAO.Database
Dim appOutlook As Object
Dim olMail As Object
Dim varPadrões As String
Dim rsPadrões As DAO.Recordset
Dim varcontrole As Integer
Dim Sql as String

Sql = " Select * From tb_Padrões where SeuCampoContador = 1"

Set db = CurrentDb

Set rsPadrões = db.openRecordSet (Sql)


Do While Not rsPadrões.EOF And Not rsPadrões.BOF


'a partir daqui você faz o loop para percorrer os registros encontrados e mostrar no seu corpo de e-mail.

loop

Muito bom rubenscouto.
Valeu pela ajuda, está rodando legal agora.

Obrigado!