Why does VBA doesn't reach data after Row number 65,000 when using DAO with SQL language?

I have a VBA module that receives a database object, worksheet name, and two column field names as parameters to make a SQL query into another Excel table that has over 1,000,000 rows with information. But when I was debugging I noticed that my VBA code does not return the info after the row number 65,000 (approximately). This is returning wrong info and not acting properly as expected.

So, how can I handle it in my existing code?

Here is my code:

Functions

Const diretorioSA = "C:\Users\Bosch-PC\Desktop\dbLEGENDAS_ELETROPAR\"
Const BaseEletro = "dbClientesEletropar.xlsb"
Const dbClientes = "CLIENTESLDA"

Public Function Number2Letter(ByVal ColNum As Long) As String

    Dim ColumnNumber As Long
    Dim ColumnLetter As String
    
    ColumnNumber = ColNum
    ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)
    Number2Letter = ColumnLetter
    
End Function

Public Function GetWorkbook(ByVal sFullName As String) As Workbook

    Dim sFile As String
    Dim wbReturn As Workbook

    sFile = DIR(sFullName)

    On Error Resume Next
    
    Set wbReturn = Workbooks(sFile)

        If wbReturn Is Nothing Then        
            Set wbReturn = Workbooks.Open(sFullName)            
        End If
        
    On Error GoTo 0

    Set GetWorkbook = wbReturn

End Function

Public Function ReplaceChars(ByVal str As String, ByVal Lista As String) As String

    Dim buff(), buffChars() As String
    ReDim buff(Len(str) - 1): ReDim buffChars(Len(Lista) - 1)
    
    For i = 1 To Len(str):   buff(i - 1) = Mid$(str, i, 1):        Next
    For i = 1 To Len(Lista): buffChars(i - 1) = Mid$(Lista, i, 1): Next
    
    For strEle = 0 To UBound(buff)
        For listaEle = 0 To UBound(buffChars)
            If buff(strEle) = buffChars(listaEle) Then
                buff(strEle) = ""
            End If
        Next listaEle
        novoTexto = novoTexto & buff(strEle)
    Next strEle
    
    ReplaceChars = novoTexto
    
End Function

Function ConsultaBaseDeDadosELETRO(ByVal CAMPO_PESQUISA As String, _
                                   ByVal CAMPO_RETORNO As String, _
                                   ByVal NOME_PLANILHA As String, _
                                   ByRef BASES As Object, _
                                   ByVal ARGUMENTO As String) As String
On Error GoTo ERRO:

        Debug.Print BASES.Name

        Dim RSt22 As Recordset
        Set RSt22 = BASES.OpenRecordset("SELECT [" & CAMPO_RETORNO & "] FROM [" & NOME_PLANILHA & "$] WHERE [" & CAMPO_PESQUISA & "] IN ('" & ARGUMENTO & "') ;", dbOpenForwardOnly, dbReadOnly)
        Debug.Print RSt22.CacheSize & " | CONTAGEM: " & RSt22.RecordCount
        ConsultaBaseDeDadosELETRO = RSt22(CAMPO_RETORNO)
        Exit Function
ERRO:
    Debug.Print VBA.Err.Description & " | Error number: " & VBA.Err.Number & " | " & VBA.Err.HelpFile
    ConsultaBaseDeDadosELETRO = "Sem registros"
End Function

Main Subroutine

Sub ProcurarBaseEletro(ByVal PASTA As String, ByVal ARQUIVO As String, ByVal NOME_PLANILHA As String, ByVal CAMPO As String)

If ActiveCell.value = "CGC" Or ActiveCell.value = "CNPJ" Or ActiveCell.value = "cgc" Or ActiveCell.value = "cnpj" Then

    Application.ScreenUpdating = False
    Dim wks As Worksheet: Set wks = ActiveSheet
    Dim db2 As database
    Dim CellRow As Single
    Dim Cellcol_info, CellCol As String
    Dim DiretorioBase As String: DiretorioBase = diretorioSA & BaseEletro
    Dim wb As Workbook: Set wb = GetWorkbook(DiretorioBase)

    If wb Is Nothing Then        
        MsgBox "Base de dados não localizada!" & vbNewLine & "EM: " & DiretorioBase, vbCritical, "Atenção"
        Set wb = Nothing
        Set wks = Nothing
        Application.ScreenUpdating = True
        Exit Sub
        
    Else    
        wks.Activate
        CellRow = ActiveCell.row
        CellCol = Number2Letter(ActiveCell.Column)
        Cellcol_info = Number2Letter(ActiveCell.Column + 1)
        CELLCOL_LROW = ActiveSheet.Cells(ActiveSheet.Rows.Count, CellCol).End(xlUp).row
        Set db2 = OpenDatabase(DiretorioBase, False, False, "Excel 8.0")
        Columns(Cellcol_info & ":" & Cellcol_info).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Range(Cellcol_info & CellRow).value = CAMPO
        Dim Query As String
        Dim CelAtivaValue As String
        For i = CellRow + 1 To CELLCOL_LROW
            CelAtivaValue = UCase(Cells(i, CellCol).value)
            Query = ReplaceChars(CelAtivaValue, "/.- ")
            
            If Left(Query, 6) < 132714 Then
                Cells(i, Cellcol_info).value = ConsultaBaseDeDadosELETRO("CGC", CAMPO, NOME_PLANILHA, db2, Query)
            Else
                Cells(i, Cellcol_info).value = ConsultaBaseDeDadosELETRO("CGC", CAMPO, NOME_PLANILHA & 2, db2, Query)
            End If
        Next i
        wb.Close        
    End If
    
Else
    MsgBox "Texto da Célula ativa não é CGC/CNPJ, impossível fazer pesquisa", vbCritical, "Valor célula ativa: " & ActiveCell.value
    Application.ScreenUpdating = True
    Exit Sub    
End If

Cells.EntireColumn.AutoFit
MsgBox "Processo concluído com sucesso.", vbOKOnly, "Informativo do sistema"
Application.ScreenUpdating = True

End Sub