MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Buscar dados em uma tabela e enviar email

    Compartilhe

    rbccosta
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Anónimo
    Mensagens : 2
    Registrado : 30/05/2016

    [Resolvido]Buscar dados em uma tabela e enviar email

    Mensagem  rbccosta em Sex 01 Jul 2016, 21:07

    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???
    avatar
    rubenscouto
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 617
    Registrado : 02/10/2011

    Re: [Resolvido]Buscar dados em uma tabela e enviar email

    Mensagem  rubenscouto em Dom 03 Jul 2016, 15:21

    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





    rbccosta
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Anónimo
    Mensagens : 2
    Registrado : 30/05/2016

    Agradecimentos

    Mensagem  rbccosta em Seg 04 Jul 2016, 16:08

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

    Obrigado!

      Data/hora atual: Dom 25 Jun 2017, 11:30