[Resolvido]Correr tabela por Mês ou 15 dias anteriores

Galera, boa tarde!

Desenvolvi um sistema de agendamentos aqui no trabalho no qual o usuário recebe os agendamentos dos fornecedores e transportadoras e após registrar o agendamento é disparado um e-mail para portaria do condomínio, portaria interna da empresa que trabalho e aproveito as informações e disponibilizo em uma TV de 60” mostrando os agendamentos de entregas e coletas. Tudo funciona perfeitamente, porém eu tenho um problema que só irá aumentar, pois quanto mais registro mais tempo demora para aparecer as informações na TV.

Aí vem a dúvida: Gostaria de saber como faço para correr a tabela dentro do mês vigente  ou nos últimos 15 dias(esse seria ideal, pois também não precisaria me preocupar com a virada do mês)

No código abaixo ele corre a "tblAgendamentoAZUL" do início até o fim e como tem muito registro e está em rede demora para aparecer o resultado

Se puderem me ajudar.

Código:


Public Sub ProgramacaoTela()
On Error Resume Next
Dim db As DAO.Database
Dim rs As DAO.Recordset
    
Set db = Application.CurrentDb
Set rs = db.OpenRecordset("tblAgendamentoAZUL") ' Corre a Tabela
    'EOF = End Of File
Do Until rs.EOF 'faça até o fim do arquivo
    'faz a comparação
   'PRIMEIRA COLUNA
  
   If rs.Fields("Data").Value = Date - 3 And rs.Fields("Horario").Value = "06:00:00" And rs.Fields("Tipo").Value = "ENTREGA" And rs.Fields("AprnaPortaria").Value >= rs.Fields("Horario").Value Then
   Form_frmAcompanhamento.txtEntrada_06.Visible = True
   Form_frmAcompanhamento.txtEntrada_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")
   Form_frmAcompanhamento.txtEntrada_06.ForeColor = RGB(0, 0, 0)    'LETRAS PRETAS
   Form_frmAcompanhamento.txtEntrada_06.BackColor = RGB(255, 255, 0) 'FUNDO AMARELO
    
ElseIf rs.Fields("Data").Value = Date - 3 And rs.Fields("Horario").Value = "06:00:00" And rs.Fields("Tipo").Value = "ENTREGA" And rs.Fields("AprnaPortaria").Value < rs.Fields("Horario").Value Then
    Form_frmAcompanhamento.txtEntrada_06.Visible = True
    Form_frmAcompanhamento.txtEntrada_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")
    Form_frmAcompanhamento.txtEntrada_06.ForeColor = RGB(255, 255, 255) 'LETRAS BRANCAS
    Form_frmAcompanhamento.txtEntrada_06.BackColor = RGB(34, 177, 76)   'FUNDO VERDE
        
'ElseIf rs.Fields("Data").Value = Date - 3 And rs.Fields("Horario").Value = "06:00:00" And rs.Fields("Tipo").Value = "ENTREGA" Then
 '  Form_frmAcompanhamento.txtEntrada_06.Visible = True
  ' Form_frmAcompanhamento.txtEntrada_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")
  
ElseIf rs.Fields("Data").Value = Date - 3 And rs.Fields("Horario").Value = "06:00:00" And rs.Fields("Tipo").Value = "COLETA" Then
   Form_frmAcompanhamento.txtSaida_06.Visible = True
   Form_frmAcompanhamento.txtSaida_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")
  
ElseIf rs.Fields("Data").Value = Date - 3 And rs.Fields("Horario").Value = "06:00:00" And rs.Fields("Tipo").Value = "ENTREGA E COLETA" Then
  
   Form_frmAcompanhamento.txtSaida_06.Visible = True
   Form_frmAcompanhamento.txtSaida_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")
   Form_frmAcompanhamento.txtEntrada_06.Visible = True
   Form_frmAcompanhamento.txtEntrada_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")

End If

   rs.MoveNext

   Loop

    'fechar conexão
    rs.Clone
    db.Close

    'libera memória
   Set rs = Nothing
   Set db = Nothing

End Sub


Este é uma parte do código, pois tem muito mais If...ElseIf

Algumas contribuições:
1 - Carregue somente a parte da tabela que interessa no momento. Digamos que quer pegar apenas o dia de hoje, faça:
Set rs = db.OpenRecordset("SELECT * FROM tblAgendamentoAZUL WHERE [Data] = " & Cdate(now()) & "; )

2 - Abra a tabela em modo leitura (dbOpenSnapshot), pois fica mais rápido:
Set rs = db.OpenRecordset("SELECT * FROM tblAgendamentoAZUL WHERE [Data] = " & Cdate(now()) & "; ),dbOpenSnapshot

3 - Jamais use palavras reservadas do MS-Access como nome de campo. Ter um campo chamado Data "quebra as pernas " do Access e pode lhe trazer resultados inesperados.

Montei essa resposta sem testar, portanto pode ter algum erro de sintaxe.

Boa noite,

Atente aos bons conselhos do colega Coltro

Altere também o código para

Código:

Public Sub ProgramacaoTela()
On Error Resume Next
Dim db As DAO.Database
Dim rs As DAO.Recordset
   
Set db = Application.CurrentDb
Set rs = db.OpenRecordset("SELECT * FROM tblAgendamentoAZUL WHERE Data=Date()-3") ' Corre a Tabela
    'EOF = End Of File
Do Until rs.EOF 'faça até o fim do arquivo
    'faz a comparação
  'PRIMEIRA COLUNA
 
  If rs.Fields("Horario").Value = "06:00:00" And rs.Fields("Tipo")= "ENTREGA" And rs.Fields("AprnaPortaria") >= rs.Fields("Horario") Then
  Form_frmAcompanhamento.txtEntrada_06.Visible = True
  Form_frmAcompanhamento.txtEntrada_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")
  Form_frmAcompanhamento.txtEntrada_06.ForeColor = RGB(0, 0, 0)    'LETRAS PRETAS
  Form_frmAcompanhamento.txtEntrada_06.BackColor = RGB(255, 255, 0) 'FUNDO AMARELO
   
ElseIf rs.Fields("Horario") = "06:00:00" And rs.Fields("Tipo") = "ENTREGA" And rs.Fields("AprnaPortaria") < rs.Fields("Horario") Then
    Form_frmAcompanhamento.txtEntrada_06.Visible = True
    Form_frmAcompanhamento.txtEntrada_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")
    Form_frmAcompanhamento.txtEntrada_06.ForeColor = RGB(255, 255, 255) 'LETRAS BRANCAS
    Form_frmAcompanhamento.txtEntrada_06.BackColor = RGB(34, 177, 76)  'FUNDO VERDE
       
'ElseIf rs.Fields("Data") = Date - 3 And rs.Fields("Horario") = "06:00:00" And rs.Fields("Tipo") = "ENTREGA" Then
 '  Form_frmAcompanhamento.txtEntrada_06.Visible = True
  ' Form_frmAcompanhamento.txtEntrada_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")
 
ElseIf rs.Fields("Horario") = "06:00:00" And rs.Fields("Tipo") = "COLETA" Then
  Form_frmAcompanhamento.txtSaida_06.Visible = True
  Form_frmAcompanhamento.txtSaida_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")
 
ElseIf And rs.Fields("Horario") = "06:00:00" And rs.Fields("Tipo") = "ENTREGA E COLETA" Then
 
  Form_frmAcompanhamento.txtSaida_06.Visible = True
  Form_frmAcompanhamento.txtSaida_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")
  Form_frmAcompanhamento.txtEntrada_06.Visible = True
  Form_frmAcompanhamento.txtEntrada_06 = rs.Fields("Transportadora") & " - " & rs.Fields("Placa") & " - " & rs.Fields("Motorista")

End If

  rs.MoveNext

  Loop

    'fechar conexão
    rs.Clone
    db.Close

    'libera memória
  Set rs = Nothing
  Set db = Nothing

End Sub

Obrigado Alexandre / Coltro


vou testar e logo respondo se deu certo.

valeu

Tentei os código acima, mas não obtive sucesso

vasculhando na internet achei um exemplo abaixo, vou tentar adaptar ao meu código

Código:


Public Sub ProgramacaoTela()
On Error Resume Next

Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset

Set dbs = CurrentDb

'Obter a consulta de parâmetro
Set qfd = dbs.QueryDefs("qryMyParameterQuery")

'Forneça o valor do parâmetro
qdf.Parameters("EnterStartDate") = Date
qdf.Parameters("EnterEndDate") = Date + 7

'Abra um Recordset com base na consulta de parâmetro
Set rst = qdf.OpenRecordset()


Obrigado, deu certo.

Boa noite,
Faltou o "Resolvido"