código sql muito lento

Boa tarde!
to tentando carregar uma listbox com o seguinte código:

Set rs = CurrentDb.OpenRecordset("SELECT CódigoDoPedido, CódigoDoCliente, DataDoPedido FROM tab_Pedido where DataDoPedido Between Date()-360 and Date()")
listPedidos = ""
Do While Not rs.EOF
listPedidos.AddItem rs!CódigoDoPedido & ";" & rs!CódigoDoCliente & ";" & rs!DataDoPedido
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Mas ta lento demais, o que ta errado?
será que ta carregando muito registro?
Até quantos registro era pra carregar rápido? 1000? 5000?
Obrigado.

Boa noite

Ao invés de usar list.add Item
Use o Set me.minhalista = Nothing
Set me.minhalista = rs.RecordSet

Ator
José

Boa noite!Obrigado por responder.
Se eu usar set me.lista.recordset = rs a tabela fica aberta, é isso que eu não queria, e se eu usar rs.close não carrega a lista.
Tem alguma ideia de como resolver isso?

Bom dia

Crie um Módulo e cole esse Código:

Dim connection As New ADODB.connection

Public result_set As ADODB.Recordset

Public data_reader As ADODB.Recordset
'Método para abrir a conexao
Public Sub Abrir_Conexao()
Dim database_provider As String
Dim connection_string As String
Dim database_local As String
Dim database_nome As String
Dim database_senha As String

database_provider = "Microsoft.Jet.OLEDB.4.0;" 'extensão .mdb
'ou
database_provider = "Microsoft.ACE.OLEDB.12.0;" 'extensão .accdb

database_local = "pasta do local do banco de dados\"

database_nome = "nome do banco de dados e a extensão "

connection_string = "Provider =" + database_provider + "Data Source ="+ database_local + database_nome + "Jet OLEDB:Database Password =" & database_senha

Set Connection = New ADODB.Connection
Connection.CursorLocation = adUseClient
Connection.Open url_data_base
End Sub
'Método para fechar a conexao
Public Sub Fechar_Conexao()
Connection.Close
Set Connection = Nothing
End Sub
'Método para executar os comandos CRUD
Public Sub Executar_Query(query As String)
Set result_set = New ADODB.Recordset
Abrir_Conexao
result_set.Open query, Connection, adOpenStatic
Set result_set = Nothing
Fechar_Conexao
End Sub
'Método para executar o Select
Public Sub Executar_Data_Reader(query As String)
Set data_reader = New ADODB.Recordset
data_reader.Open query, Connection, adOpenStatic
End Sub
'Método para fechar o Select
Public Sub Fechar_Data_Reader()
data_reader.Close
Set data_reader = Nothing
Fechar_Conexao
End Sub

Depois é só instanciar o objeto da Classe conexão nos formulários que quiser, exemplo:

Option Compare Database
Dim conexao As New Cls_Conexao

Sub Preencher_lst_medicacao()
Dim query As String

query = "SELECT medicacao_codigo,medicacao_estoqueatual,medicacao_estoqueminimo,medicacao_estoquemaximo,medicacao_datavalidade,medicacao_nome " & _
" FROM medicacao " & _
" WHERE " & "strConv(medicacao.medicacao_nome, 2, 1049) LIKE '%" & StrConv(Me.txt_medicacao_nome.Text, 2, 1049) & "%' " & _
" ORDER BY medicacao_nome"

conexao.Abrir_Conexao
conexao.Executar_Data_Reader (query)

Set Me!lst_medicacao.Recordset = Nothing
Set Me!lst_medicacao.Recordset = conexao.data_reader

conexao.Fechar_Data_Reader
End Sub

Joao,

duas dicas, mantendo o OpenRecordset.

1ª - Abra a lista de propriedades do campo DataDoPedido, lá na tabela tab_pedido, e altere a propriedade INDEXADO para SIM

2º - Acrescente no argumento Type, do OpenRecordset, o valor 4 ou 8

Set rs = CurrentDb.OpenRecordset("SELECT CódigoDoPedido, CódigoDoCliente, DataDoPedido FROM tab_Pedido where DataDoPedido Between Date()-360 and Date()", 4)

Sucesso!

Obrigado por responderem, to quebrando a cabeça aqui, depois retorno.

Boa tarde!Consegui fazer o código.
Carrega uma matriz, depois carrega um recordset com a matriz, depois carrega uma listbox ou subformulario com o recordset, ficou rápido, quase 29.000 registros em uns 4 segundos.
segue o código:

carrega a matriz

Function CarregaMatriz()
Dim i As Integer
Dim X As Integer
Dim y As Integer
X = 0
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT Tab_Pedido.CódigoDoPedido, Tab_Pedido.CódigoDoCliente, Tab_Pedido.DataDoPedido, Tab_Pedido.CódigoDoFuncionário, Tab_Cliente.NomeDoCliente, Tab_Funcionário.NomeDoFuncionário FROM (Tab_Pedido INNER JOIN Tab_Cliente ON Tab_Pedido.CódigoDoCliente = Tab_Cliente.CódigoDoCliente) INNER JOIN Tab_Funcionário ON Tab_Pedido.CódigoDoFuncionário = Tab_Funcionário.CódigoDoFuncionário")


rst.MoveLast
y = rst.RecordCount
rst.MoveFirst
ReDim strPedidos(0 To y, 4)
Do While Not rst.EOF
strPedidos(X, 0) = rst("CódigoDoPedido")
strPedidos(X, 1) = rst("CódigodoCliente")
strPedidos(X, 2) = rst("DataDoPedido")
strPedidos(X, 3) = rst("NomeDoCliente")
strPedidos(X, 4) = rst("NomeDoFuncionário")

rst.MoveNext
X = X + 1
Loop

rst.Close


End Function
'xxxxxxxxxxxxxxxxxxxxxxxxxx

carrega lista ou subform

Function CarregaLista()
Dim rst As ADODB.Recordset
Dim i As Integer

Set rst = New ADODB.Recordset
With rst
   .Fields.Append "Pedido", adInteger
   .Fields.Append "CodCli", adInteger
    .Fields.Append "Data", adDate
     .Fields.Append "Cliente", adVarChar, 50
     .Fields.Append "Funcionário", adVarChar, 50
   .Open , , adOpenStatic, adLockOptimistic
  For i = 0 To UBound(strPedidos)
       .AddNew
       On Error Resume Next
     
     
       !Pedido = strPedidos(X, 0)
       !codCli = strPedidos(X, 1)
        !Data = strPedidos(X, 2)
        !Cliente = UCase(strPedidos(X, 3))
        !Funcionário = UCase(strPedidos(X, 4))
       
       .Update
 
   .MoveNext
   X = X + 1
   Next i
 Set Me.listPedidos.Recordset = rst

 .Close
End With
Set rst = Nothing