MaximoAccess

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

Obrigado

Administração do MaximoAccess


Participe do fórum, é rápido e fácil

MaximoAccess

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

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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

    [Resolvido]Buscar dados em uma tabela e enviar email

    avatar
    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 Empty [Resolvido]Buscar dados em uma tabela e enviar email

    Mensagem  rbccosta 1/7/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???
    rubenscouto
    rubenscouto
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

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

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

    Mensagem  rubenscouto 3/7/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




    avatar
    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 Empty Agradecimentos

    Mensagem  rbccosta 4/7/2016, 16:08

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

    Obrigado!

      Data/hora atual: 1/3/2021, 20:17