Пустой набор записей, если нет результатов в первых 10 строках

Question

У меня есть следующий код, который извлекает данные из закрытого файла и выводит результат в новый почтовый объект.Файл данных содержит 500 тыс. Строк, но если запрос не находит результат в первых 10 строках, он возвращает пустой набор записей:

    Sub MailingListQuery()

Application.ScreenUpdating = False
Dim c As Range
Dim d As Range
Dim Cn As ADODB.Connection
Dim Fichier As String
Dim NomFeuille As String, texte_SQL As String
Dim cmd As ADODB.Command
Dim Rst As ADODB.Recordset
'Dim CoPo as String
Dim CoPo() As String
Dim i As Integer
Dim Region As String
Dim lNumElements As Long

Dim MailAddress As Variant
ReDim MailAddress(0 To 0)
Region = ThisWorkbook.Worksheets("Menu").Range("H3").Value

'Closed WB location
Fichier = ThisWorkbook.Worksheets("Menu").Range("B7").Value

'Sh in closed WB
NomFeuille = "FMCSA_CENSUS1_2018Apr_chunk4"

If ThisWorkbook.Worksheets("Menu").Range("D3").Value = "Canada" Then
    With Worksheets(ThisWorkbook.Worksheets("Menu").Range("F3").Value).Range("F2:F" & Worksheets(ThisWorkbook.Worksheets("Menu").Range("F3").Value).Range("B65535").End(xlUp).Row)
        Set d = .Find(What:=Region, LookIn:=xlValues, MatchCase:=False, Lookat:=xlWhole)
        If Not d Is Nothing Then
            CoPo = Split(d.Offset(0, -3).Value, " ")
        End If
    End With
Else
    With Worksheets("Zip US").Range("F2:F" & Worksheets(ThisWorkbook.Worksheets("Menu").Range("F3").Value).Range("B65535").End(xlUp).Row)
        Set d = .Find(What:=Region, LookIn:=xlValues, MatchCase:=False, Lookat:=xlWhole)
        If Not d Is Nothing Then
            CoPo = Split(d.Offset(0, -3).Value, " ")
        End If
    End With
End If

'Debug
lNumElements = UBound(CoPo) - LBound(CoPo)
For i = 0 To lNumElements
    Worksheets("Debug").Range("A" & i + 1) = CoPo(i)
Next i
'------------------------------------------------------------------------------------------

Set Cn = New ADODB.Connection

'--- Connexion ---
With Cn
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    .Open
End With
'-----------------
lNumElements = UBound(CoPo) - LBound(CoPo)
For i = 0 To lNumElements
    'Request
    If ThisWorkbook.Worksheets("Menu").Range("B3") = "Tous" Then
        request_SQL = "SELECT [" & NomFeuille & "$].[MAILING_ZIP], [" & NomFeuille & "$].[EMAIL_ADDRESS] FROM [" & NomFeuille & "$]"
    Else
        request_SQL = "SELECT [" & NomFeuille & "$].[MAILING_ZIP], [" & NomFeuille & "$].[EMAIL_ADDRESS] FROM [" & NomFeuille & "$] WHERE [" & NomFeuille & "$].[MAILING_ZIP] LIKE ?"
    End If

    Set cmd = New ADODB.Command
    cmd.ActiveConnection = Cn
    cmd.CommandText = request_SQL
    cmd.Parameters.Append cmd.CreateParameter("@postalCode", adVarChar, adParamInput, 50)

    cmd.Parameters("@postalCode").Value = CoPo(i) + "%"

    Set Rst = cmd.Execute

    'Worksheets("Debug").Range("B1").CopyFromRecordset Rst 'Attention! vide le rst, le reste du code ne retournera rien, pour voir les records seulement

    Do While Not Rst.EOF
        If Not IsNull(Rst("EMAIL_ADDRESS").Value) Then
            If Not IsInArray(Rst("EMAIL_ADDRESS").Value, MailAddress) And ValidateEmailAddress(Rst("EMAIL_ADDRESS").Value) Then
                If IsEmpty(MailAddress) Then
                    MailAddress = Rst("EMAIL_ADDRESS").Value
                Else
                    ReDim Preserve MailAddress(1 To UBound(MailAddress) + 1)
                    MailAddress(UBound(MailAddress)) = Rst("EMAIL_ADDRESS").Value
                End If
            End If
        End If
        Rst.MoveNext
    Loop
Next i
'--- Outlook ---

If Not UBound(MailAddress) = 0 Then

    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    On Error Resume Next

    With OutMail

        .BCC = Join(MailAddress, ", ")
        '.Subject = "This is the Subject line"
        '.Body = strbody
        'SendUsingAccount is new in Office 2007
        'Change Item(1)to the account number that you want to use
        '.SendUsingAccount = OutApp.Session.Accounts.Item(1)
        .Display '.Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    Call HistEvoie
Else
    MsgBox "Aucun résultat trouvé"
End If
Application.ScreenUpdating = True
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
End Sub

Когда я ищу запись вручную, я не нахожу их без проблем,если параметр встречается в первых 10 строках, возвращается полный набор записей для строк 500 000, если нет, то набор записей пуст.Я сделал так, чтобы столбец поиска был полностью текстовым, чтобы убедиться, что с числовым / строковым типом не происходит ничего странного.Столбец содержит почтовые индексы Канады и США и может содержать тире "-", но на первый взгляд кажется, что это не причина проблемы.

СПАСИБО