Accélérer une macro de recherche de fichiers

[Chris57]

Bonjour à tous,

dans le cadre de mon travail j'ai besoins d'une macro qui va "scanner" les fichiers excel se situant dans un dossier d'archivage (minimul 2 archives pas jours) puis qui va récupérer des valeurs dans les 2 dernières archives.

Pour ce faire, je suis passé par une astuce :

Sub ListeFichier()
    
' ICI JE PLACE DANS DES VARIABLES LA PREMIERE PARTIE DES NOMS DES FICHIERS QUE JE CHERCHE
       [B2:B3,D1].ClearContents

        DOSSIERarchive = "L:\UP78\CONTRAINTES TECHNIQUES\Archives UP78 " & Year(Date) '& "\"
        fichierARCHIVE = "CONTRAINTES TECHNIQUES  UP 7&8 du "

        DATEarchive = Format(Date + 1, "dd") & Format(Date + 1, "mm") & Year(Date)
        fichierARCHIVE = fichierARCHIVE & DATEarchive & "_"
        [B2] = DOSSIERarchive
        [B3] = fichierARCHIVE
        
        Application.ScreenUpdating = False
        

 JE FOUILLE DANS LE DOSSIER D'ARCHIVES ET J'Y CHERCHE LES FICHIERS COMMENCANT PAR LES VARIABLES PRECEDENTES
        Dim objFSO, objDossier, objFichier, objResultat
    
        On Error Resume Next
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objDossier = objFSO.GetFolder(DOSSIERarchive)
        
' Explore le dossier "DOSSIERarchive" et inscrit le noms des archives de demain

          LIGNE = 4
            If (objDossier.Files.Count > 0) Then
                For Each objFichier In objDossier.Files
                   If Left(objFichier.Name, 43) = fichierARCHIVE And (InStr(1, objFichier.Name, ".xlsx", 1) > 0) Then
                       Cells(LIGNE, 2) = objFichier.Name
                       LIGNE = LIGNE + 1
                   End If
                Next objFichier
            End If

            objResultat.Close
            Set objResultat = Nothing
            Set objDossier = Nothing
            Set objFSO = Nothing
        
        
 ' Compte le nombre de fichiers trouvés
       NBREfichiers = Range("B100").End(xlUp).Offset(1, 0).Row - 4
        [D1] = "Nombre de fichiers trouvés pour le " & DATEarchive & " = " & NBREfichiers
        
 ' Créé les liens hypertexte
    For i = 1 To NBREfichiers
            fichierARCHIVE = Range("B" & i + 3)
            [E5].Offset(i + 7, 0) = "='" & DOSSIERarchive & "\[" & fichierARCHIVE & "]CT_UP_78'!$B$7"
            ' à suivre.....
     Next i

End Sub

Donc je cherche les noms des dernièrs fichiers puis je créé des liens hypertext à l'aide de ces noms pour récupérer les valeurs dont j'ai besoins.
Le problème est que le dossier d'archive 2012 contient à ce jour 530 fichiers et donc la macro est très longue à s'executer !!

Peut-on l'accélérer ???

 

[phlaurent55]

Re : Accélérer une macro de recherche de fichiers

Bonjour Chris,

sans voir ton fichier:

en début de code:
Application.Calculation = xlCalculationManual -----> Bloque le calcul automatique pendant la procédure

en fin de code:
Application.Calculation = xlCalculationAutomatic --------> retour à la normale (re-calcule une fois les cellules contenant des formules )

voici un lien traitant du même sujet ( lenteur)
https://www.excel-downloads.com/threads/vba-application-screenupdating.191661/


à+

Philippe

 

[MJ13]

Re : Accélérer une macro de recherche de fichiers

Bonjour Chris, Philippe

Tu peux tester ce fichier Dir_Dossier6.xls pour lister des fichiers d'un dossier et des sous-dossier. J'obtiens 1600 fichiers en 6 secondes.

 

[Chris57]

Re : Accélérer une macro de recherche de fichiers

Bonjour Chris, Philippe

Tu peux tester ce fichier Dir_Dossier6.xls pour lister des fichiers d'un dossier et des sous-dossier. J'obtiens 1600 fichiers en 6 secondes.

Sur le PC du boulot je l'ai laissé tourner bien 5 min et j'ai du l'interrompre ! il n'avait listé que 260 fichiers sur 530...
C'est peut-être parce que je suis sur réseau...

En fait je connais cette procédure car je l'utilise chez moi pou lister des mp3 sous excel et elle est très rapide. Ici au boulot c'est ultra long !

[EDIT] j'ai transféré les fichiers sous C:\ et c'est pareil, ultra long, beaucoup plus que ma procédure ci-dessus !

Bonjour Chris,

sans voir ton fichier:

en début de code:
Application.Calculation = xlCalculationManual -----> Bloque le calcul automatique pendant la procédure

en fin de code:
Application.Calculation = xlCalculationAutomatic --------> retour à la normale (re-calcule une fois les cellules contenant des formules )

voici un lien traitant du même sujet ( lenteur)
https://www.excel-downloads.com/threads/vba-application-screenupdating.191661/


à+

Philippe

Je connais cette manip et je l'avais déjà testé, mais elle n'apporte rien rien il n'y pas de calculs à actualiser durant la macro de recherche de fichier.

 

[MJ13]

Re : Accélérer une macro de recherche de fichiers

Re

Sur le PC du boulot je l'ai laissé tourner bien 5 min et j'ai du l'interrompre ! il n'avait listé que 260 fichiers sur 530...
C'est peut-être parce que je suis sur réseau...

En fait je connais cette procédure car je l'utilise chez moi pou lister des mp3 sous excel et elle est très rapide. Ici au boulot c'est ultra long !

[EDIT] j'ai transféré les fichiers sous C:\ et c'est pareil, ultra long, beaucoup plus que ma procédure ci-dessus !

Bizarre, en effet 😕.

Mais, as tu testé la macro avec juste le fichier Dir_Dossier6?

Sinon, teste la macro sur un dossier de moins de 100 fichiers pour voir le temps de scrutations.

 

[Chris57]

Re : Accélérer une macro de recherche de fichiers

Effectivement j'avais testé ton fichier commel tel. Mais là je viens de faire un autre test : au lieu d'ouvrir directement ton fichier à partir de ce site, je l'ai enregistré sur mon bureau et je l'ai ouvert après.

Puis j'ai donné un lien vers un dossier sur le C:\ : 532 fichiers en 2,47 sec !!!
Le même dossier sur le disque serveur : 532 fichiers en 69.06 sec

Donc il fallait déjà que j'enregistre ton fichier sur mon PC pour gratter du temps. Maintenant je vais essayer de réduire ta macro en virant pas exemple les détails des fichiers.