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

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

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

Sub test_récup_plage()
    Dim fichier$, Tbl
    fichier = ThisWorkbook.Path & "\exemple.xlsx"    'à adapter
    Tbl = GetcolumnValueOnClosedWbookskeepblank(fichier, "D2:D100000", "Feuil1", False)
     Sheets("Feuil1").[A1].Resize(UBound(Tbl), 1) = Tbl
End Sub

Function GetcolumnValueOnClosedWbookskeepblank(fichier As String, RnG As String, Feuille As String, Optional headerTable As Boolean = False)
    Dim AdConn As Object, AdoComand As Object, HDR$, RsT As Object, RsTLigne&, RsTCol&, v$, Arr()
    Set AdConn = CreateObject("ADODB.Connection")
    Set AdoComand = CreateObject("ADODB.Command")
    Set RsT = CreateObject("ADODB.RecordSet")
    HDR = Array("No", "Yes")(Abs(headerTable))
    AdConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"""
    AdoComand.ActiveConnection = AdConn
    AdoComand.CommandText = "SELECT * from `" & Feuille & "$" & RnG & "`"
    RsT.Open AdoComand, , 1, 3
    RsT.MoveFirst
    Do While Not RsT.EOF
        For RsTLigne = 1 To RsT.RecordCount  'lignes
            'If Not IsNull(RsT.Fields(0).Value) Then  a = a + 1: ReDim Preserve Arr(1 To a): Arr(a) = RsT.Fields(0).Value'( débloquer si on veut sauter les vides)
            'ou
            a = a + 1: ReDim Preserve Arr(1 To a): Arr(a) = RsT.Fields(0).Value '(bloquer si on veux sauter les vides)
            If Not Arr(a) Like "*[A-z,:,€]*" Then
                If IsDate(Arr(a)) Then Arr(a) = Format(CDate(Arr(a)), "m/d/yyyy")
            Else
                Arr(a) = Replace(Arr(a), " €", "€")
            End If
            RsT.MoveNext
        Next
    Loop

    AdConn.Close: Set RsT = Nothing: Set AdoComand = Nothing: Set AdConn = Nothing
    GetcolumnValueOnClosedWbookskeepblank = Application.Transpose(Arr)
End Function

Sub testAdO()
    Dim fichier$, nomfeuille$, DispoCel As Range
    fichier = "C:\Users\polux\DeskTop\exemple.xlsx"
    nomfeuille = "feuil1"
    Set DispoCel = [A1]
    resADO [D2:D65535], 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=NO;"";"
         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)
    destination.CopyFromRecordset Rst
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing: Set Rst = Nothing
End Function

Sub test()
chemin = "C:\Users\polux\DeskTop\"
fichier = "Exemple.xlsx"
formule = "'" & chemin & "[" & fichier & "]Feuil1'!"
'On Error Resume Next
n = ExecuteExcel4Macro("MATCH(""zzz""," & formule & "D1)") 'dernière cellule texte en colonne D
'On Error GoTo 0
MsgBox n
End Sub