pedrocsa
pedrocsa

Reputation: 59

I can´t use the command EOF with a query coming from Access

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

Answers (2)

Gustav
Gustav

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

akc42
akc42

Reputation: 5001

Use a while loop

While Not tabela.EOF

...

Wend

Upvotes: 1

Related Questions