Connexion ADODB en liaison tardive → Temps exécution de la tâche

Le 20/03/2018 à 16:49

Bonjour au forum,

Je recherche les conseils et l'aide de personnes aguerries.

J'expose ici le problème auquel je suis confrontée et je n'arrive pas à comprendre ce qui fait défaut.

Environnement : Win 7 Sp1 - Office 2010

Objectif : Une fonction Update →

Je reçois des fichiers de mes opérationnels qui nécessitent une actualisation, en effet leur version n'est pas à jour.

Je souhaite générer de nouvelles versions de ces fichiers en remplacement des versions existantes.

Pour ce faire j'ai créé un Template qui sert de gabarit.

Je récupère les data des 6 onglets et régénère ainsi chaque fichier.

Annoyance :

Le temps de traitement est, d'une part extrêmement long 6 à 16 minutes pour 22 fichiers.

D'autre part consomme énormément de ressources ce qui a tendance à faire planter Excel, et rend impossible tout autre action.

Ci joint le code

Sub Main

Option Base 1
Private Declare Function getTickCount Lib "kernel32" Alias "GetTickCount" () As Long
Const adOpenDynamic As Long = 2
Const adLockOptimistic As Long = 3
Sub Import()
    Dim start As Long, Finish As Long
    Dim Arborescence(), Var(6), Onglet()
    Dim NomFichier$, NomTemplate$, Plage$, Code$, S$
    Dim Fournisseur As String, Consommateur As String, Requete As String, FournisseurCheminComplet As String
    Dim F1 As Excel.Worksheet, Wb As Workbook
    Dim i As Long, X As Long, j As Long, k As Long, q As Long
    Dim LastRow As Integer
    Dim cnxF As Object
    Dim RstF As Object
    start = getTickCount()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    On Error GoTo ErrorHandler
    Onglet = Array("Onglet1", "Onglet2", "Onglet3", "Onglet4", "Onglet5", "Onglet6")

        NomTemplate = "Template.xlsm"
        Fournisseur = ThisWorkbook.Path & "\Toto\ToUpgrade\"
        NomFichier = Dir(Fournisseur)

        Call ListeFichiersRepertoire(Fournisseur, NomFichier)
        Arborescence = Tableau

For k = 1 To UBound(Arborescence, 2)
    FournisseurCheminComplet = ThisWorkbook.Path & "\Toto\ToUpgrade\" & Arborescence(1, k)
    S = Arborescence(1, k)

    NomTemplateOrginal = ThisWorkbook.Path & "\Toto\Template\" & NomTemplate
    NomTemplateCopy = ThisWorkbook.Path & "\Toto\ToMergeData\" & Arborescence(1, k)
    FileCopy NomTemplateOrginal, NomTemplateCopy
    Consommateur = NomTemplateCopy
    Code = Left(Arborescence(1, k), 3)
    Set Wb = GetObject(Consommateur)
    Wb.Windows(1).Visible = False
    Set cnxF = ConnectionClasseur(FournisseurCheminComplet)
        For i = 1 To UBound(Onglet)
            Set F1 = ThisWorkbook.Sheets(Onglet(i))

                With F1
                    LastRow = .Range("G2").CurrentRegion.Rows.Count
                    Plage = "G2:O" & LastRow
                    Requete = "SELECT * FROM [" & Onglet(i) & "$" & Plage & "]"
                    'Set RstF = CreateObject("ADODB.Recordset")
                     Set RstF = cnxF.Execute(Requete)
                End With
                    Select Case i
                        Case 1: Var(i) = TransposeDim(RstF.GetRows)
                        Case 2: Var(i) = TransposeDim(RstF.GetRows)
                        Case 3: Var(i) = TransposeDim(RstF.GetRows)
                        Case 4: Var(i) = TransposeDim(RstF.GetRows)
                        Case 5: Var(i) = TransposeDim(RstF.GetRows)
                        Case 6: Var(i) = TransposeDim(RstF.GetRows)
                    End Select
                    RstF.MoveFirst

                        If Not IsEmpty(Var(6)) Then
                            For q = 1 To UBound(Onglet)
                                SetExternalDatas Consommateur, (Onglet(q)), Var(q)
                            Next q
                        End If

        Next i

    RstF.Close
    cnxF.Close
    Set RstF = Nothing
    Set cnxF = Nothing
    Call RecupM(S)
    Wb.Close SaveChanges:=True

Next k
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Finish = getTickCount()
 MsgBox "Temps d'execution" & ": " & CStr((Finish - start) / 1000)
'Call FullcalcTimer
  Exit Sub

ErrorHandler:
  MsgBox Err.Number & vbLf & Err.Description

End Sub

Fonction

Option Explicit
Function ConnectionClasseur(sFichierExcel As String) As Object
Dim cnx As Object

 Set cnx = CreateObject("ADODB.Connection")
 cnx.Provider = "Microsoft.Jet.OLEDB.4.0"
 cnx.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sFichierExcel & ";Extended Properties=""Excel 12.0;HDR=No;"""
 cnx.Open
 Set ConnectionClasseur = cnx

End Function

Sous-module appelé durant l'exécution

Option Explicit
Option Base 1
Sub RecupM(S As String)

    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Feuille As Worksheet
    Dim a, i, y, n, j
    Dim table1(), table2() As Variant
    Dim DerL
    Dim compteur, Compteur1 As Long
    compteur = 0
    Compteur1 = 0
    a = Array("Onglet1", "Onglet2", "Onglet3", "Onglet4", "Onglet5", "Onglet6") 'Nom des feuilles à exclure

For Each Fe In Workbooks(S).Worksheets
Set Feuille = Workbooks(S).Sheets(Fe.Name)
        If Not IsError(Application.Match(Fe.Name, a, 0)) Then
        With Feuille
        DerL = .Range("G80").End(xlUp).Row
        compteur = Compteur1 + DerL - 1
        ReDim Preserve table1(9, compteur)

        For i = 1 To DerL - 1
            table1(1, Compteur1 + i) = .Range("G" & i + 1).Value
            table1(2, Compteur1 + i) = .Range("H" & i + 1).Value
            table1(3, Compteur1 + i) = .Range("I" & i + 1).Value
            table1(4, Compteur1 + i) = .Range("J" & i + 1).Value
            table1(5, Compteur1 + i) = .Range("K" & i + 1).Value
            table1(6, Compteur1 + i) = .Range("L" & i + 1).Value
            table1(7, Compteur1 + i) = .Range("M" & i + 1).Value
            table1(8, Compteur1 + i) = .Range("N" & i + 1).Value
            table1(9, Compteur1 + i) = .Range("O" & i + 1).Value
        Next i

        Compteur1 = compteur
    End With

        End If

    Next Fe
    ReDim table2(UBound(table1, 2), UBound(table1, 1))

    For y = 1 To 9
            For j = 1 To 66
                table2(j, y) = table1(y, j)
            Next j
        Next y
        With Workbooks(S).Worksheets("Consolidation")
            .Range("G2").Resize(UBound(table2, 1), UBound(table2, 2)) = table2
        End With

    Call ControlCellValueM

End Sub

Merci de toute l'aide que vous pourrez m'apporter

Le 20/03/2018 à 18:51

Bonjour Eliot

Déjà revoir le script de connexion :

1/ Inutile d'avoir 2 provider différents (dans ton code => Jet puis ACE à la ligne suivante, ??ouatzef..k??)

2/ Pour se lier avec un autre fichier excel, inutile d'utiliser le provider ACE (spécialisé pour des bases Access)

3/ Un bon provider est plutôt MSDASQL avec le driver Excel, soit :

    Cnx.Provider = "MSDASQL"
    Cnx.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
             "DBQ=" & sFichierExcel & "; ReadOnly=False;"

Ensuite pour un Select, il te faut un objet ADODB.Recordset (le Execute est à réserver pour les Insert ou Update), du genre :

        Set Rst = CreateObject("ADODB.Recordset")
        Rst.Open Requete, Cnx, 3

Ensuite il te suffit de placer le résultat du Select dans un tableau quelconque (ici T par exemple) pour le traiter ensuite, genre :

Dim T As Variant
        Rst.MoveFirst
        T = Rst.GetRows

Ensuite j'ai pas bien compris ce que tu cherches à faire, ton code est trop fouilli, incomplet, mal indenté, les variables ne sont pas toutes typées, bref difficile à lire et à en comprendre le sens. Par exemple il y a quoi dans 'TransposeDim' et dans SetExternalDatas'??

Pas sûr qu'on puisse t'aider plus si tu n'expliques pas mieux ta démarche (exemple : tu parles d'un Update et ton code ne comporte qu'un Select ??ouatzef..k??-bis)

Pierre

Le 20/03/2018 à 19:27

Bonjour Pierre,

Enfin! Merci pour ta franche observation, j'apprends progressivement mais je cherchais aussi une personne susceptible de qualifier mon travail... bon bah ça c'est fait

ton code est trop fouilli, incomplet, mal indenté, les variables ne sont pas toutes typées,

Pour le typage je consens, mais peux-tu expliciter pour fouillis et incomplet.

Mal indenté → D'accord je vais revoir l'indentation

Udpate ? Non Upgrade

User story

  • Contexte

Il existe deux fichiers

Le premier est un fichier dit opérationnel.

Celui-ci est destiné aux gestionnaires

Le deuxième est un fichier dit stratégique, destiné à l'administrateur qui est en charge de la récupération des données.

La fonction Upgrade se trouve uniquement sur le fichier destiné à ce dernier.

  • Actions réalisées

1 - Des fichiers sont envoyés à des opérationnels sur le terrain en début de mois(même structure pour tous)

2 - L'opérationnel retourne le fichier à l'administrateur chaque fin de mois

3 - Supposons que des évolutions ont été réalisées entre temps sur le gabarit. (modification de code, ajout de chart etc...)

3.1 - L'administrateur regroupe alors tous les fichiers dans un dossier nommé ToUpgrade

3.2 - Puis, l'administrateur viendra cliquer sur le bouton Upgrade situé sur son Dashboard

Illustration de l'arborescence décrite ci-dessus

arbo1

Correspond à

NomTemplateOrginal = ThisWorkbook.Path & "\Toto\Template\" & NomTemplate

NomTemplateCopy = ThisWorkbook.Path & "\Toto\ToMergeData\" & Arborescence(1, k)

* Arborescence(1,k) correspond à la liste des fichiers présent dans le répertoire que l'on stock dans un tableau temporaire

Code correspondant à Arborescence

Public Sub ListeFichiersRepertoire(Repertoire, Fichier)
    Dim X As Integer, i As Integer
    Dim VerifTab As Variant

    Do While Fichier <> ""
        X = X + 1
        ReDim Preserve Tableau(1, X)
        Tableau(1, X) = Fichier
        Fichier = Dir
    Loop

    On Error Resume Next
    VerifTab = UBound(Tableau)
    On Error GoTo 0

    If IsEmpty(VerifTab) Then Exit Sub
End Sub

Résultat de sortie :

Pour chaque fichier

1 - Création d'une copie du template dans le dossier ToMerge qui sera renommé avec le nom du fichier original

( FileCopy NomTemplateOrginal, NomTemplateCopy)

2 - Récupération des données contenues dans les onglets 1 à 6 du fichier orginal

"SELECT * FROM [" & Onglet(i) & "$" & Plage & "]"

3 - Insertion dans le TemplateCopy des données

Appel de SetExternalDatas, qui écrit les données ainsi récupérées et stockées dans des Tableaux Temporaires

FIN → on passe au suivant et on répète les action 1,2,3

SetExternalDatas correspond au code suivant

Option Explicit
Public Sub SetExternalDatas(DestFile As String, DestFeuille As String, DataToWrite As Variant)

Dim LastRow, Plage, Chemin
Dim NomFichier, NomFichierSaveAs
Dim Path$, Folder$
Dim FSO As Object

NomFichier = Dir(DestFile)
With Workbooks(NomFichier).Worksheets(DestFeuille)
    LastRow = .Range("G2").CurrentRegion.Rows.Count
    Plage = "G2:O" & LastRow
End With

Workbooks(NomFichier).Worksheets(DestFeuille).Range(Plage) = DataToWrite

End Sub

TransposeDim à la fonction suivante

Option Explicit
Function TransposeDim(v As Variant) As Variant

    Dim X As Long, y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant

    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)

    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For y = 0 To Yupper
            tempArray(X, y) = v(y, X)
        Next y
    Next X

    TransposeDim = tempArray

End Function

Pour finir on consolide toutes les données dans une feuille consolidation (Sub RecupM)

J'espère avoir été plus précise.

Merci

Le 21/03/2018 à 10:55

Incomplet parce que, par exemple, tu n'avais pas mis le code de ton 'TransposeDim'

Fouillis parce que, par exemple, il y a des redondances : 'compteur', 'compteur1' et le 'i' de la boucle for de 'RecupM'.

Parce que les variables ne sont pas toutes déclarées.

Parce que tu déclares 'Option Base 1' et plus loin tu as un 'For X = 0 To Xupper' pour boucler sur un tableau, ce qui laisse à supposer que ici ton lbound est à 0 et non à 1.

Parce que tes 'Option Explicit' laissent à supposer que tu as un module pour chaque procédure.

Parce que, parce que ...

... Bref, est-ce que j'ai bien compris :

* Tous les mois tu récupères n fichiers de tes n p'tits gars, et tu veux :

* lire les data de "G2:O" & LastRow (des 6 onglets de chaque fichier)

* coller ces data dans un fichier maitre.

Est-ce que c'est ça la démarche?

Si c'est le cas, au lieu d'un long discours, voici un exemple fonctionnel : un fichier principal et un dossier contenant 2 fichiers xlsx (le tout ici avec seulement 2-3 onglets, mais le code est prévu pour 6)

Dans le fichier principal un bouton pour lancer l'import, via AdoDb.

Les data sont collés à partir de A2 mais c'est facile à modifier dans le code.

(nb: extraire les fichiers du zip vers un dossier de son PC)

Est-ce que ça va dans le bon sens?

Pierre

14demo-eliott.zip (44.28 Ko)
Le 28/05/2018 à 11:12

Bonjour Pierre,

J'ai été prise sur d'autres projets qui se sont enchaînés, ce qui ne m'a pas permis de revenir ici plus tôt.

Je replonge aujourd'hui sur celui-ci.

Je vais prendre le temps de regarder ton code pour l'assimiler.

Merci d'avoir pris de ton temps.

Eliotte

Rechercher des sujets similaires à "connexion adodb liaison tardive temps execution tache"