Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 Adodb.Connection lente à s'établir

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion fanch55
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

fanch55

XLDnaute Barbatruc
Bonjour à tous,

J'utilise ( et conseille beaucoup) Adodb pour extraire des données d'un tableau surtout pour charger des listboxes ou comboboxes.
Les données peuvent ainsi être triées, filtrées et uniques grâce au moteur Sql avant d'être récupérées .

Sauf que depuis quelque temps, la fonction qui était quasi immédiate jusqu'alors prend plus de 10 secondes à chaque Open du classeur qui contient la "Database", même si c'est celui qui est actif .

Je suis persuadé que c'est encore un coup de Windows Update !!!???? 🤔
Ma config : W11, Office 2021 et 32go de mémoire.

Je n'ai plus de pc sous W10 et/ou Office plus ancien pour vérifier mes dires
Si quelqu'un pouvait tester le mini-classeur ci-joint et me dire s'il fait mieux, cela me permettrait de poster sur un site Microsoft pour protester ....
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
jurassic pork à dit:
Hello,
regarde ici : si tu as une version 2503 , soit tu attends une correction de Microsoft, ou soit tu downgrades à une version 2502.
Ami calmant, J.P
Cliquez pour agrandir...
Merci JP, c'est clair !
M....ince je suis en 2504, pas de correction depuis la 2503 ...
Bon, je vais peut-être rétrograder si je trouve un peu de temps,
( j'aurai pu faire une recherche sur le forum, grogntudju )

@patricktoulon, merci de ta participation, cela démontre bien que cela fonctionnait correctement ...
 
Vote positif 0 Vote négatif
@fanch55
tu veux bien essayer la mienne
colle ça dans un module
elle fonctionne aussi pour les fichiers fermés
VB: 
Sub test_récup_One_column()
    Dim fichier$, Tbl, combo
    fichier = ThisWorkbook.FullName    'à adapter
    Tbl = GetcolumnValueOnClosedWbookskeepblank(fichier, Range("T_FournisseurBis").Address(0, 0), ActiveSheet.Name, False)
    
     'je suis dans un module donc l'acces par le feuil1.combobox1 n'est pas possible
     'il faut donc convertir en msforms.combobox le oleobject
     Set combo = ActiveSheet.OLEObjects("ComboBox1").Object
     combo.Clear
     combo.List = Tbl
    ' 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'( si on veut sauter les vides)
            'ou
            a = a + 1: ReDim Preserve Arr(1 To a): Arr(a) = Rst.Fields(0).Value '(on saute pas 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
 
Vote positif 0 Vote négatif
re:
après control avec le timer la mienne est plus rapide
edit : bonjour jean-marie oui je viens de voir ça
c'est pas tout à fait le même moteur ou driver
j'aimerais bien que @fanch55 la teste
ça permet de voir aussi ce qui reste d'actualité en terme de driver ou moteur de requête

quand j'enlève les replace pour mon besoins je gagne encore un peu
VB: 
Sub test_récup_One_column()
    Dim fichier$, Tbl, combo, tim
    
    fichier = ThisWorkbook.FullName    'à adapter
   tim = Timer
   Tbl = GetcolumnValueOnClosedWbookskeepblank(fichier, Range("T_FournisseurBis").Address(0, 0), ActiveSheet.Name, False)
    
     'je suis dans un module donc l'acces par le feuil1.combobox1 n'est pas possible
     'il faut donc convertir en msforms.combobox le oleobject
     Set combo = ActiveSheet.OLEObjects("ComboBox1").Object
     combo.Clear
     combo.List = Tbl
    MsgBox "Select terminé en " & Timer - tim & " secondes"
    ' 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 '( si on veut sauter les vides)
            'ou
            'a = a + 1: ReDim Preserve Arr(1 To a): Arr(a) = Rst.Fields(0).Value '(on saute pas 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
 
Vote positif 0 Vote négatif
Exact cela prend 6 secondes par ta méthode et pareil pour la mienne avec le même driver .
C'est 50% mieux mais pas acceptable, le temps restant inchangé quel que soit le nombre d'enregistrements à traiter .
Ma combobox1 est déjà un activex, pas de conversion à faire .
 
Dernière édition:
Vote positif 0 Vote négatif
sur 2013 feuil1.combobox1.list=tbl
ne fonctionne pas c'est pour ça que je converti
je l'ai réécrite de facon a ce que le choix soit possible de la méthode pour le filtre skeepblancks
j'ai ajouté l'index de la colonne aussi comme ça on travail sur une plage et on choisi la colonne
VB: 
Sub test_récup_One_column()
    Dim fichier$, Tbl, combo, tim
    
    fichier = ThisWorkbook.FullName    'à adapter
    tim = Timer
    Tbl = GetcolumnValueOnClosedWbookskeepblank(fichier, Range("T_FournisseurBis").Address(0, 0), ActiveSheet.Name, 1, False, True)
    
    'je suis dans un module donc l'acces par le feuil1.combobox1 n'est pas possible
    'il faut donc convertir en msforms.combobox le oleobject
    Set combo = ActiveSheet.OLEObjects("ComboBox1").Object
    combo.Clear
    combo.List = Tbl
    MsgBox "Select terminé en " & Timer - tim & " secondes"
    ' Sheets("Feuil1").[A1].Resize(UBound(Tbl), 1) = Tbl
End Sub

Function GetcolumnValueOnClosedWbookskeepblank( _
                                               fichier As String, _
                                               RnG As String, _
                                               Feuille As String, _
                                               Optional colonne As Long = 1, _
                                               Optional headerTable As Boolean = False, _
                                               Optional skeepBlancks As Boolean)
    
    Dim AdConn As Object, AdoComand As Object, HDR$, Rst As Object, RsTLigne&, RsTCol&, v$, Arr(), ok As Boolean
    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
    '=================================================================
    'Option 1
    'mode Less ou tardif  on ne filtre pas les blancs Attention au caractères (Backsticks)
    'AdoComand.CommandText = "SELECT * from `" & Feuille & "$" & RnG & "`"
    '================================================================
    'Option 2
    'mode pré avec le where is null on elimine les bla"ncs
    AdoComand.CommandText = "SELECT * FROM [" & Feuille & "$" & RnG & "]" & IIf(skeepBlancks, " WHERE F" & colonne & " IS NOT NULL", "")
    '================================================================
    Rst.Open AdoComand, , 1, 3
    Rst.MoveFirst
    Do While Not Rst.EOF
        'lignes
        For RsTLigne = 1 To Rst.RecordCount
            '=================================================================
            'Option 1
            'mode tardif si on utilise pas le where is null on filtre les bla"ncs da"ns une boucle sur les fields
            'ok = skeepBlancks And Not IsNull(Rst.Fields(0).Value) = True
            'f ok Then
            'a = a + 1: ReDim Preserve Arr(1 To a): Arr(a) = Rst.Fields(0).Value '( si on veut sauter les vides)
            'End If
            'ou
            '=================================================================
            'Option 2
            'Mode pré avec where(on rempli simplement le tableau
            '(on saute pas les vides)
            a = a + 1
            ReDim Preserve Arr(1 To a)
            Arr(a) = Rst.Fields(0).Value
            '=================================================================
            Rst.MoveNext
        Next
    Loop
    
    AdConn.Close
    Set Rst = Nothing
    Set AdoComand = Nothing
    Set AdConn = Nothing
    GetcolumnValueOnClosedWbookskeepblank = Application.Transpose(Arr)
End Function
comme ça ça m'a fait un peu rafraichir mes vieux codes
là elle est bien rafraichie
après si c'est pas suffisant il faut attendre la mise a jour ou correctif pour la 2504
chez moi option 1 ou option 2 je tourne à( 0.05xxxxx / 0.07xxxxx)
il n'y a pas beaucoup de noms dans ta colonne
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon à dit:
il n'y a pas beaucoup de noms dans ta colonne
Cliquez pour agrandir...
Montage pour l'exemple avec une table simple et bien épurée
J'avais déjà testé l'ace.ole.db dans le temps, mais il était moins performant que Excel Driver .
Et il fallait toujours le modifier avec les dernières versions, actuellement c'est la 16.0 je suis surpris par ta 12.0 qui est une version 32bits et qui est censée ne pas être compatible avec un office 64bits !!!!
 
Vote positif 0 Vote négatif
que cela te tienne dans l'idée
VB: 
'exo patricktoulon tuto
==========================================================================
'Model d 'appel
'Tbl = GetcolumnValueOnClosedWbookskeepblank( _
                                             "chemin complet du fichier", _
                                             "l'address du range", _
                                             "le nom de la feuille", _
                                             index_de_la_Colonne, _
                                             Header, _
                                             skeepblanks)
'=========================================================================
Sub test_récup_One_column()
    Dim fichier$, Tbl, combo, tim
   
    fichier = ThisWorkbook.FullName    'à adapter
    tim = Timer
    Tbl = GetcolumnValueOnClosedWbookskeepblank( _
                                                fichier, _
                                                Range("T_FournisseurBis").Address(0, 0), _
                                                ActiveSheet.Name, _
                                                1, _
                                                False, _
                                                True)
   
   
    'je suis dans un module donc l'acces par le feuil1.combobox1 n'est pas possible
    'il faut donc convertir en msforms.combobox le oleobject
    Set combo = ActiveSheet.OLEObjects("ComboBox1").Object
    combo.Clear
    combo.List = Tbl
    MsgBox "Select terminé en " & Timer - tim & " secondes"
    ' Sheets("Feuil1").[A1].Resize(UBound(Tbl), 1) = Tbl
End Sub

Function GetcolumnValueOnClosedWbookskeepblank( _
                                               fichier As String, _
                                               RnG As String, _
                                               Feuille As String, _
                                               Optional colonne As Long = 1, _
                                               Optional headerTable As Boolean = False, _
                                               Optional skeepBlancks As Boolean)
   
    Dim AdConn As Object, AdoComand As Object, HDR$, Rst As Object, RsTLigne&, RsTCol&, v$, Arr(), ok As Boolean
    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." & Val(Application.Version) & ".0;Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"""
    AdoComand.ActiveConnection = AdConn
    '=================================================================
    'Option 1
    'mode Less ou tardif  on ne filtre pas les blancs Attention au caractères (Backsticks)
    'AdoComand.CommandText = "SELECT * from `" & Feuille & "$" & RnG & "`"
    '================================================================
    'Option 2
    'mode pré avec le where is null on elimine les blancs
    AdoComand.CommandText = "SELECT * FROM [" & Feuille & "$" & RnG & "]" & IIf(skeepBlancks, " WHERE F" & colonne & " IS NOT NULL", "")
    '================================================================
    Rst.Open AdoComand, , 1, 3
    Rst.MoveFirst
    Do While Not Rst.EOF
        'lignes
        For RsTLigne = 1 To Rst.RecordCount
            '=================================================================
            'Option 1
            'mode tardif si on utilise pas le where is null on filtre les bla"ncs da"ns une boucle sur les fields
            'ok = skeepBlancks And Not IsNull(Rst.Fields(0).Value) = True
            'If ok Then
            'a = a + 1: ReDim Preserve Arr(1 To a): Arr(a) = Rst.Fields(0).Value '( si on veut sauter les vides)
            'End If
            'ou
            '=================================================================
            'Option 2
            'Mode pré avec where(on rempli simplement le tableau
            '(on saute pas les vides)
            a = a + 1
            ReDim Preserve Arr(1 To a)
            Arr(a) = Rst.Fields(0).Value
            '=================================================================
          Rst.MoveNext
   
        Next
         Loop
   
    AdConn.Close
    Set Rst = Nothing
    Set AdoComand = Nothing
    Set AdConn = Nothing
    GetcolumnValueOnClosedWbookskeepblank = Application.Transpose(Arr)
End Function
chez moi j'obtiens 15 et ça tourne impec
 
Dernière édition:
Vote positif 0 Vote négatif
delire j'a"i détérré les vieux machin j'ai adapté
VB: 
Private Sub trucbidulechouette()
    Sheets(1).ComboBox1.Clear
    Dim rs As Object, cnn As Object, tim
    Set cnn = CreateObject("ADODB.Connection")
    'Set rs = CreateObject("ADODB.RecordSet")'latebinding  full anonyme le recordset sera" le resultat de Adodb.Connection.execute
    fichier = ThisWorkbook.FullName
    tim = Timer
    
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & fichier & ";" & _
              "Extended Properties='Excel 12.0;HDR=Yes;IMEX=1'"
    
    Set rs = cnn.Execute("SELECT [Nom] FROM [Fournisseur$] WHERE [Nom] IS NOT NULL AND [Nom] <> ''")
     ActiveSheet.ComboBox1.Column = rs.GetRows
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
   MsgBox "Select terminé en " & Timer - tim & " secondes"
End Sub


on passe donc par un recorset anonyme et par le .column de la combobox
timer 0.03xxxxxx
punaise qu'est ce que j'ai pu m'amuser avec ça
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…