XL 2019 extraire des données d'un fichier Excel sans l'ouvrir avec VBA

Sub Importer_TXT()
Dim t#, chemin$, fichier$, ncol%, texte$, i&, s, n&, a(), col%, resu(), dest As Range
t = Timer
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Source.txt" 'à adapter
ncol = 8 'nombre de colonnes à copier
'---lecture séquentielle du fichier texte---
Open chemin & fichier For Input As #1 'ouverture du fichier texte
Do While Not EOF(1) 'EndOfFile: fin du fichier
    Line Input #1, texte 'récupère la ligne
    i = i + 1
    s = Split(texte, vbTab) 'séparateur : tabulation
    If i = 1 Or s(3) = "4GF" Then 'critère en 4ème colonne
        n = n + 1
        ReDim Preserve a(1 To ncol, 1 To n)
        For col = 1 To ncol
            a(col, n) = s(col - 1)
        Next col
    End If
Loop
Close #1 'fermeture du fichier texte
'---transposition---
ReDim resu(1 To n, 1 To ncol)
For i = 1 To n
    For col = 1 To ncol
        resu(i, col) = a(col, i)
Next col, i
'---restitution dans la feuille Excel quand c'est possible---
With Feuil1 'CodeName à adapter
    If .FilterMode Then .ShowAllData
    Set dest = .[A1] '1ère cellule de destination, à adapter
    If n > .Rows.Count - dest.Row + 1 Then MsgBox "Tableau trop grand pour Excel !", 48: Exit Sub
    If n Then dest.Resize(n, ncol) = resu
    dest.Offset(n).Resize(.Rows.Count - n - dest.Row + 1, ncol).ClearContents 'RAZ en dessous
    With .UsedRange: End With 'actualise les barres de défilement
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \sec"), , "Import"
End Sub

Sub Importer()
Dim t#, chemin$, fichier$, dercol$, formule$, n&
t = Timer
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Source.xlsx" 'à adapter
dercol = "H" 'dernière colonne à copier
formule = "'" & chemin & "[" & fichier & "]Feuil1'!"
On Error Resume Next
n = ExecuteExcel4Macro("MATCH(""zzz""," & formule & "C4)") 'dernière cellule texte en colonne D
On Error GoTo 0
'---restitution---
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille de destination
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("A1:" & dercol & 1).Resize(n)
        .FormulaArray = "=" & formule & "A1:" & dercol & n 'formule de liaison matricielle
        .Value = .Value 'supprime la formule
       .Rows(1) .Offset(n).Resize(Rows.Count - n).ClearContents 'RAZ en dessous
        .Sort .Columns(4), Header:=xlYes 'tri pour regrouper et accélérer
        .Columns(4).Replace "4GF", "#N/A"
        On Error Resume Next
        .Columns(4).Offset(1).SpecialCells(xlCellTypeConstants, 3).EntireRow.Delete 'textes et nombres
        .Columns(4).Replace "#N/A", "4GF"
        .Replace 0, "", xlWhole 'efface les valeurs zéro
    End With
    With .UsedRange: End With 'actualise les barres de défilement
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \sec"), , "Import"
End Sub

Sub testAdO()
    Dim fichier$, nomfeuille$, DispoCel As Range
    fichier = ThisWorkbook.Path & "\Planning_GDS.xlsm"
    nomfeuille = "Liste_ressources"
    Set DispoCel = [M3]
    resADO [A1:D300000], fichier, nomfeuille, DispoCel
End Sub
Function resADO(plage, fichier, nomfeuille, destination)


'Dim Cn As ADODB.Connection, texte_SQL$, Rst As ADODB.Recordset
    Dim Cn As Object, texte_SQL$, Rst As Object
      Set Cn = CreateObject("ADODB.Connection")
     Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"";"
         texte_SQL = "SELECT * FROM [" & nomfeuille & "$" & plage.Address(0, 0) & "]"  'la requête.    ' Attention!!!!!!! à ne pas oublier le symbole "$" après le nom de la feuille.


    
    
    Set Rst = CreateObject("ADODB.RecordSet")
    Set Rst = Cn.Execute(texte_SQL)
    
       '--- Boucle sur les entêtes pour récupérer les noms ---
    For i = 0 To Rst.Fields.Count - 1
    Cells(2, i + 13).Activate
        Cells(2, i + 13) = Rst.Fields(i).Name
    Next i
    
    destination.CopyFromRecordset Rst
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing: Set Rst = Nothing
End Function