Reputation: 59
After running a query and get a recordcount of 596 records, I try to do a Do Until/Loop to populate a listview, using the EOF.
But the problem is that it already starts the "Do Until tabela.EOF" recognizing the End Of File.
Why, if it have more then 500 itens on the table?
Public Function ConsultaTabela_3(Optional ByVal planilha As String, Optional ByVal Consulta As String, Optional ByVal linha As String, Optional ByVal coluna As String, Optional ByVal prm1 As String, Optional ByVal prm2 As String, Optional ByVal prm3 As String, Optional ByVal prm4 As String, Optional ByVal prm5 As String, Optional ByVal prm6 As String)
Dim sSQL As String
Dim banco As ADODB.Connection
Dim tabela As ADODB.Recordset
Dim query As ADODB.Command
Dim parametro1, parametro2, parametro3, parametro4, parametro5, parametro6 As ADODB.Parameter
'Dim caminhoDB As String
caminhoDB = ThisWorkbook.Path & "\" & "CALCULO_SLA.accdb"
On Error GoTo trataErro
'caminhoDB = Replace(ThisWorkbook.FullName, "MEDICAO_ALIMENTACAO.xlsm", "") & "MEDICAO_ALIMENTACAO.accdb"
Set banco = New ADODB.Connection
banco.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & caminhoDB & ";Persist Security Info=False"
' Abre a query ACCESS
Set query = New ADODB.Command
Set query.ActiveConnection = banco
query.CommandText = Consulta
query.CommandType = adCmdStoredProc
' Pego o valor do param. e adiciono no command
Set parametro1 = query.CreateParameter("prm1", adChar, adParamInput, 255)
query.Parameters.Append parametro1
If prm1 = "" Then
parametro1.Value = Null
Else
parametro1.Value = prm1
End If
Set parametro2 = query.CreateParameter("prm2", adChar, adParamInput, 255)
query.Parameters.Append parametro2
If prm2 = "" Then
parametro2.Value = Null
Else
parametro2.Value = prm2
End If
Set parametro3 = query.CreateParameter("prm3", adChar, adParamInput, 255)
query.Parameters.Append parametro3
If prm3 = "" Then
parametro3.Value = Null
Else
parametro3.Value = prm3
End If
Set parametro4 = query.CreateParameter("prm4", adChar, adParamInput, 255)
query.Parameters.Append parametro4
If prm4 = "" Then
parametro4.Value = Null
Else
parametro4.Value = prm4
End If
Set parametro5 = query.CreateParameter("prm5", adChar, adParamInput, 255)
query.Parameters.Append parametro5
If prm5 = "" Then
parametro5.Value = Null
Else
parametro5.Value = prm5
End If
Set parametro6 = query.CreateParameter("prm6", adChar, adParamInput, 255)
query.Parameters.Append parametro6
If prm6 = "" Then
parametro6.Value = Null
Else
parametro6.Value = prm6
End If
' Executa a query no ACCESS
query.Execute
' Retorna a query para a tabela temporária e cola no excel
Set tabela = New ADODB.Recordset
tabela.CursorLocation = adUseClient
tabela.Open query
a = tabela.RecordCount
ActiveWorkbook.Sheets(planilha).Cells(CInt(linha), CInt(coluna)).CopyFromRecordset tabela
Do Until tabela.EOF
Set li = lstResultado.ListItems.Add(, , tabela!TB_IW29_Nota)
If Not IsNull(tabela!TB_IW29_Ordem) Then li.ListSubItems.Add Text:=tabela!TB_IW29_Ordem
li.ListSubItems.Add Text:=tabela!TB_IW29_Descrição
RST.MoveNext
Loop
' Limpando memória
tabela.Close
Set tabela = Nothing
banco.Close
Set banco = Nothing
Exit Function
trataErro:
MsgBox ("Erro: " & Err.Description)
End Function
Upvotes: 1
Views: 267
Reputation: 55921
It seems like you have to move to the top first:
a = tabela.RecordCount
ActiveWorkbook.Sheets(planilha).Cells(CInt(linha), CInt(coluna)).CopyFromRecordset tabela
If a > 0 Then
tabela.MoveFirst
End If
Do Until tabela.EOF
Upvotes: 3