XL 2021 Adodb.Connection lente à s'établir

Sub test2()
    Dim fichier, Tim#
    fichier = ThisWorkbook.FullName
    Tim = Timer
    TableToComboBoxList fichier, "Fournisseur", "Nom", True, True, True, True, True, ActiveSheet.ComboBox1
    MsgBox "Select terminé en " & Timer - Tim & " secondes"
End Sub

Sub test3()
    Dim fichier, Tim#, tbl
    fichier = ThisWorkbook.FullName
    Tim = Timer
    tbl = TableToComboBoxList(fichier, "Fournisseur", "Nom", True, True, True, True, True)
    If Not IsEmpty(tbl) Then
        [L1].Resize(UBound(tbl)) = tbl
        MsgBox "Select terminé en " & Timer - Tim & " secondes"
    End If
End Sub


Function TableToComboBoxList(fichier, _
                             feuille, _
                             NomColonne, _
                             Optional WithHeader As Boolean = False, _
                             Optional SkeepBlanks As Boolean = False, _
                             Optional Ordre As Boolean = False, _
                             Optional ShuntDouble As Boolean = False, _
                             Optional formalise As Boolean = False, _
                             Optional Combo As Object) As Variant
    
    TableToComboBoxList = Empty
    If Not Combo Is Nothing Then Combo.Clear
    Dim rs As Object, cnn As Object, version&, Sql As String, distinct As String
    With Application
        version = .Min(Val(.version), 16)
    End With
    If ShuntDouble Then distinct = "DISTINCT "
    Set cnn = CreateObject("ADODB.Connection")
    
    'Set rs = CreateObject("ADODB.RecordSet")'latebinding  full anonyme le recordset sera" le resultat de Adodb.Connection.execute
    
    cnn.Open "Provider=Microsoft.ACE.OLEDB." & version & ".0" & ";" & _
              "Data Source=" & fichier & ";" & _
              "Extended Properties='Excel 12.0" & ";" & _
              "HDR=" & Array("No", "Yes")(Abs(WithHeader)) & ";IMEX=" & Abs(formalise) & "'"
    'exemple
    'Set rs = cnn.Execute("SELECT [nom de colonne] FROM [Nom de la feuille] WHERE [nom de colonne] IS NOT NULL AND [Nom] <> '' ORDER BY [Nom]")
    
    'LA feuille
    Sql = "SELECT " & distinct & "[" & NomColonne & "] "
    
    'LE NOM DE LA COLONNE(HEADER)
    Sql = Sql & "FROM [" & feuille & "$]"
    
    'LE WHERE pour les paramètres(pas de vides)
    If SkeepBlanks Then Sql = Sql & " WHERE [" & NomColonne & "] IS NOT NULL AND [" & NomColonne & "] <> ''"
    
    'ORDER
    If Ordre Then Sql = Sql & " ORDER BY [" & NomColonne & "]"
    Debug.Print Sql
    
    'DECISION
    '===========================================================================
    'on sait ici tout de suite si on s'arrête soit pour une erreur soit pour l'EOF
    ' on en profite pour récupérer lea desciption d'erreur si il y en a une
    Dim yes As Boolean, ed As String
    yes = True
    On Error Resume Next
    Set rs = cnn.Execute(Sql)
    If Err Then
        yes = False
        ed = Err.Description
    End If
    On Error GoTo 0
    If rs.EOF Then yes = False
    'à partir de là ed est soit le descriptif de l'erreur soit vide
    'et yes en fonction des deux
    'même avec une erreur le code ne s'arrêtra pas
    ' il pa"ssera" tout simplement la condition if yes (si c'est false c'est les Else qui agiront)
    '===========================================================================
    
    
    ' si oui
    If yes Then
        arr = rs.getrows ' récup le tableau
        If Not Combo Is Nothing Then
            Combo.Column = arr
        Else
            TableToComboBoxList = Application.Transpose(arr)
        End If
    Else 'si non
        If Not Combo Is Nothing Then
            MsgBox "la requete n'a pas aboutie ! , la " & Combo.Name & " ne sera pas remplie" & vbCrLf & ed
        Else
            MsgBox "la requete n'a pas aboutie !" & vbCrLf & ed
        End If
    End If
    
    'destruction des object de connection
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Function

Public Function Get_Fields( _
        Target As Variant, _
        Select_String As Variant, _
        Optional Column_Widths As String = "-1", _
        Optional File_Base As String, _
        Optional Headers As Boolean) As Boolean
 
    Dim Ro       As Boolean
    Dim Base    'As ADODB.Connection
    Dim Requete 'As ADODB.Recordset
    Dim tempFile As String
    tempFile =  Environ("TEMP") & "\" & ThisWorkbook.Name
    ThisWorkbook.SaveCopyAs tempFile
    Get_Fields = False
   ' Classeur dans lequel est la base
   ' If File_Base = "" Then File_Base = ThisWorkbook.FullName
 
    'On Error Resume Next
    Ro = IIf(InStr(Trim(Select_String), "select") = 1, True, False)
    Set Base = CreateObject("ADODB.Connection")
        Base.CursorLocation = 3
        Base.Open Sql_Driver & ";ReadOnly=" & Ro & ";DBQ=" & tempFile ' on utilise le classeur temporaire
        Set Requete = CreateObject("ADODB.Recordset")