XL 2021 Adodb.Connection lente à s'établir

fanch55 · 17 Mai 2025

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 ....

jurassic pork · 17 Mai 2025

Hello,
voir ici pour le problème.
regarde ici pour une solution temporaire : si tu as une version 2503 , soit tu attends une correction de Microsoft, ou soit tu downgrades à une version 2502.
Ami calmant, J.P

patricktoulon · 17 Mai 2025

Bonjour @fanch55
chez moi c'est assez rapide

fanch55 · 17 Mai 2025

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

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 ...

ChTi160 · 17 Mai 2025

Bonjour le Fil
Chez Moi ! (pas cool ! Lol)
Cordialement
Jean marie

fanch55 · 17 Mai 2025

ChTi160 à dit:
Bonjour le Fil
Chez Moi ! (pas cool ! Lol)
Cordialement
Jean marie

Tu fais partie de ceux qui sont béta testeurs à l'insu de leur plein gré ....

patricktoulon · 17 Mai 2025

@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

ChTi160 · 17 Mai 2025

Pour Patrick que je salue
ta version divise le temp de traitement par 2 (6.109275)! Merci Lol
Jean marie

patricktoulon · 17 Mai 2025

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

fanch55 · 17 Mai 2025

patricktoulon à dit:
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

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 .

patricktoulon · 17 Mai 2025

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

fanch55 · 17 Mai 2025

patricktoulon à dit:
il n'y a pas beaucoup de noms dans ta colonne

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 !!!!

patricktoulon · 17 Mai 2025

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

patricktoulon · 17 Mai 2025

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

dysorthographie · 18 Mai 2025

Bonjour,
Pour mon information personnelle, ça prend moins de temps à ce connecter sur thisworkbook.fullname?

Effectuez une recherche sur Excel Downloads...

XL 2021 Adodb.Connection lente à s'établir

fanch55

XLDnaute Barbatruc

Pièces jointes

jurassic pork

jurassic pork

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

Nous accordons de l'importance à votre vie privée