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

    Alterar registro ao correr a tabela

    Compartilhe

    juliobertoso
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 21
    Registrado : 23/10/2017

    Alterar registro ao correr a tabela

    Mensagem  juliobertoso em 23/5/2018, 21:12

    boa tarde!

    preciso de uma ajuda para finalizar um projeto, tenho uma tabela que envia e-mail automaticamente.
    Ao correr a tabela e verificar o campo "Status" se estiver escrito "Veiculo Liberado" o sistema envia um email com todos os dados da tabela e muda o "Status" de "Veiculo Liberado" para "Agendado"
    quando tem só um registro como "Veiculo Liberado" o sistema funciona tranquilo, o problema que tem o Loop e pra verificar a tabela inteira, entao quando passa para segunda linha não altera o Status

    segue o código do envio de email

    coloquei a função abaixo depois que passa pelo status "Veiculo Liberado" mas acho que não seria assim, pq só esta mudando o 1° registro encontrado e eu quero que mude todos que são necessários

    Form_frmAgendamentoSUB.Status = "AGENDADO"

    Código:
    Public Sub EnviarEmailAgendamento()
    '   ****IMPORTANTE, NAO ESQUECER DE FAZER A REFERENCIA PARA OUTLOOK ********
    'Dim OutApp As Object
    'Dim strbody As String
    Dim strLocal As String
    Dim SigString As String
    Dim Signature As String
    Dim Assinatura As String
    Dim LogoAzul As String
    Dim Horario As String

        Dim db As DAO.Database
        Dim rs As DAO.Recordset
        'Referêcia Microsoft Outlook
      Dim OutApp As Outlook.Application
      Dim OutMail As Outlook.MailItem
        
        Dim anexo As String
        
        Set db = Application.CurrentDb
        Set rs = db.OpenRecordset("tblAgendamentoAZUL") ' Corre a Tabela
     
        'Inicializando o Ms-Outlook
        Set OutApp = New Outlook.Application
        
            'Informe o Local onde se encontra sua assinatura, podendo ser no Computador ou URL de Algum Site
        Assinatura = "C:\Users\julio.bertoso\Documents\Agendamento\assinatura.png"
        LogoAzul = "C:\Users\julio.bertoso\Documents\Agendamento\logo.png"
        
        'EOF = End Of File
        Do Until rs.EOF 'faça até o fim do arquivo
        'faz a comparação
            'If rs.Fields("VencimentoCNH_Funcionario").Value <= rs.Fields("Data_Funcionario4").Value Then '= "Sim"
           If rs.Fields("Status").Value = "Veiculo Liberado" Then
           Form_frmAgendamentoSUB.Status = "AGENDADO"
          
            
            'MsgBox "Segue agendamento para: " & "  " & rs!Transportadora & " " & rs!Motorista
            
            
            
             If Format(Time$, "hh:mm") >= "18:00:00" Then
             Horario = "Boa Noite!"
             strLocal = "Campinas, " & Format(Date, "dd") & " de " & Format(Date, "mmmm") & " de " & Format(Date, "yyyy") & "."
      
             ElseIf Format(Time$, "hh:mm") >= "12:00:00" Then
             Horario = "Boa Tarde!"
             strLocal = "Campinas, " & Format(Date, "dd") & " de " & Format(Date, "mmmm") & " de " & Format(Date, "yyyy") & "."
        
             ElseIf Format(Time$, "hh:mm") >= "00:00:00" Then
             Horario = "Bom dia!"
             strLocal = "Campinas, " & Format(Date, "dd") & " de " & Format(Date, "mmmm") & " de " & Format(Date, "yyyy") & "."
        
        End If
            
            'Novo Email
            Set OutMail = OutApp.CreateItem(olMailItem)
            With OutMail
                            
             .To = "meuemail@email.com"   'rs.Fields("Email_Transportadora").Value
             .CC = ""
             .BCC = "" 'Copia oculta
             .Subject = "Agendamento de" & " " & rs!Tipo & " " & "para transportadora" & " " & rs!Transportadora & " " & "dia " & rs!Data & " " & "- " & rs!Horario   'txtAssunto ' ver um jeito de nao deixar em branco
             .BodyFormat = olFormatHTML
             '<img src="/images/hackanm.gif" width="20" height="20">
                
        .HTMLBody = "<HTML><BODY><FONT FACE=Calibri (Corpo) COLOR=1F497D<B>" & _
        "<img src=" & LogoAzul & ">" & "<BR><BR>" & _
        strLocal & _
        "</B><BR><BR>" & Horario & "<BR><BR></BR>" & _
        "Segue agendamento de " & rs!Tipo & " " & "para transportadora abaixo:" & "<BR><BR></BR>" & _
        "  " & "<B>" & "Data: " & "</b>" & rs!Data & " " & "<B>" & "Horário: " & "</B>" & rs!Horario & _
        "<BR><BR>" & "<B>" & "Veículo: " & "</B>" & " " & rs!TipodeVeiculo & "<B>" & " " & "Placa: " & "</B>" & " " & rs!Placa & "<BR>" & _
        "" & "<B>" & "Rotina: " & "</B>" & " " & rs!Rotina & "<B>" & " " & "Tipo: " & "</B>" & " " & rs!Tipo & "<BR><BR>" & _
        "" & "<B>" & "Transportadora: " & "</B>" & " " & rs!Transportadora & "<BR>" & _
        "  " & "<B>" & "Motorista: " & "</B>" & rs!Motorista & " " & "<B>" & "RG: " & "</B>" & rs!RG_Motorista & "<BR>" & _
        "  " & "<B>" & "Ajudante: " & "</B>" & rs!Ajudante & " " & "<B>" & "RG: " & "</B>" & rs!RG_Ajudante & "<BR><BR>" & _
        "" & "<B>" & "Empresa: " & "</B>" & " " & rs!Empresa & "<BR>" & _
        "  " & "<B>" & "Responsável: " & "</B>" & rs!Responsavel & " " & "<B>" & "Telefone: " & "</B>" & rs!Telefone & "<BR>" & _
        "<B>" & "<BR>" & _
        "<BR> Atenciosamente, <BR><BR><BR>  <img src=" & Assinatura & ">" & "</FONT></BODY></HTML>"
        .Display
              
                '.Body = "CNH de " & "  " & rs!Nome_Funcionario & " do setor " & rs!Departamento_Funcionario & " esta vencida, favor solicitar a renovação, venceu dia " & rs!VencimentoCNH_Funcionario  'txtCorpo
                
                '.Attachments.Add anexo = Application.CurrentProject.Path & "\Agenda\" & rs.Fields("Transportadora").Value & ".pdf"
                 .Display
                 '.Send
             End With
                'Libera memória
                 Set OutMail = Nothing
            End If
            
            rs.MoveNext
        Loop
        'fechar conexão
        rs.Clone
        db.Close
        'libera memória
        Set rs = Nothing
        Set db = Nothing
         Set OutApp = Nothing
        
        
        
         'MsgBox "foi enviado um email automático informando!", vbInformation
    End Sub

      Data/hora atual: 19/10/2018, 12:36