Problème lenteur macro

Bonjour à tous

J'ai un petit soucis avec une macro courte qui permet de lister les fichiers d'un répertoire dans une feuille excel.

Le code est le suivant, trouvé sur le net:

Sub liste_des_fichiers()

Dim Dossier As String, Fichier As String, i As Integer

Dossier = "C:\Users\......\" 'chemin d'accès au dossier

i = 0

Fichier = Dir(Dossier)

Do While Fichier <> ""

  i = i + 1

  Sheets("Données").Range("A" & i) = Fichier

  Fichier = Dir

Loop

End Sub

En fait je l'ai essayé au travail dans un dossier comportant 800 fichiers et la macro à mis presque 15 à 20 secondes pour lister les noms des fichiers dans la feuille.

alors que les noms de fichiers en question sont très court 6 caractères numériques voir 8 grand max. et sont soit des .pdf soit des .jpg

Je viens d'arriver chez moi et je viens de faire un dossier fictif ou j'ai fait un copié collé de fichier .TXT vide (0ko) jusqu'à en avoir 800, comme c'est des copiés collés le noms des fichiers sont relativement long:

Pourtant la macro c'est terminé en quelques micro secondes.

Je me suis demandé du coup si ça venait du poids du fichier, j'ai donc réitéré avec des fichier photo de 1.5Mo (moyenne des poids des fichiers à mon travail)

même résultat la macro se termine en quelques micro secondes.

Au travail j'ai essayé de mettre

Application.ScreenUpdating = False

pour gagner du temps mais rien y fait.

Du coup la macro à l'air d'être efficace et rapide mais quelque chose au travail fait que cela prend presque 20 secondes.

Les pistes possibles:

- Dans une autre feuilles des formules font intervenir la feuille ou sont stocker la liste des fichiers en question, peut-être faut-il désactiver les formules du classeur excel avant d'exécuter la macro? (je ne sais pas comment faire si cela est possible)

- Le fichier excel comporte 3 macro évènement type double click mais pas sur la feuille ou sont listé les noms de fichier, cela peut-il créer des interférences?

- Le dossier se trouve sur le réseau de l'entreprise dans un dossier commun d'un collègue de travail, est-ce du au réseau ?

Avez vous déjà eut ce genre de problème en milieu professionnel, avez vous des solutions pour y remédier?

est-ce que la qualité du réseau de l'entreprise peut intervenir dans le temps d'exécution de la macro? (le réseau de l'entreprise en question est très au point, réactif etc..) est-ce que ça peux causer un écart de temps d'exécution aussi conséquent? 0.2 secondes en local contre 15 secondes en réseau...

Merci d'avance pour vos réponses.

bonjour,

sur ton PC, tu peux avoir de meilleure performance si tu as un SSD, mais cela n'explique pas des différences de entre 0.2 sec et 20 sec.

le problème peut venir du classeur (le plus probable), du PC, du réseau ou du serveur (ou le PC sur lequel se trouve le répertoire).

pour désactiver les formules (se mettre en mode calcul manuel). menu formules, option de calcul-> manuel. et lancer la macro. si pas de différence, c'est peut-être le PC.

faire le test en utilisant un répertoire qui se trouve sur le disque dur du PC et comparer par rapport au répertoire se trouvant sur le réseau. Si pas de différence, il y a sans doute un programme sur ton PC qui ralentit les accès fichiers (anti-virus ?), Si différence le temps supplémentaire est dû au réseau ou au serveur de fichiers, cela prendra plus de temps, mais si c'est configuré correctement et que les ressources sur le server sont suffisantes, cela n'explique pas la différence que tu constates.

oui je tu as raison je vais refaire le test au travail, avec un fichier vierge et en local pour pouvoir espérer chercher d'où vient le problème.

déjà ça ne vient pas du type de disque car le premier test avec les fichier.txt je l'ai fais sur mon SSD et le 2eme avec les photos sur un HDD et aucunes différences ou du moins pas perceptible.

Pour la désactivation des formules, existe t'il un code dans VBA que je puisse mettre au début de ma macro puis le réactiver en fin de macro?

Bonjour,

Essayer ce code

Sub liste_des_fichiers()

    Dim Dossier As String, Fichier As String, i As Integer, tb_fichiers()

    Dossier = "C:\Users\......\" 'chemin d'accès au dossier

    i = 0
    Fichier = Dir(Dossier)
    Do While Fichier <> ""

        ReDim Preserve tb_fichiers(i): tb_fichiers(i) = Fichier
        i = i + 1
        Fichier = Dir

    Loop

    Sheets("Données").Range("A1").Resize(UBound(tb_fichiers) + 1).Value = Application.Transpose(tb_fichiers)

End Sub

Serait-ce un code magique qui arrive a contrôler d'abord la liste crée via la première macro et ne rajoute seulement que les nouveaux fichiers trouvées à la liste ?

j'avais pensé à demander quelque chose comme ça, mais je me suis dis, si c''est déjà long de juste copier une liste il va prendre plus de temps à vérifier d'abord mais c'est peut-être pas le cas.

he non ou ubound c'est pas une sorte de tableau virtuelle en mémoire tampon qui permet de gagner du temps?

Merci thev !!

Je vais tester ça lundi voir si ça résout mon problème.

Re Thev! Ta macro marche du tonnerre, l'exécution se fait en quelque micro seconde. C'est parfait.

Bonjour Thev, j'espère que tu pourra lire ce message,

Je fais remonter ce poste car je souhaiterais savoir si il est possible d'adapter ton code pour une nouvelle utilisation.

J'ai une nouvelle problématique, j'indique un chemin.

Exemple : C:\images

Mais cette fois ci je voudrais que la recherce se fasse au dossier mais aussi aux sous dossiers qu'il contient.

Je voudrais aussi qu'il ne remonte que la liste des fichiers ayant un type particulier dextension.

Exemple ".bmp"

Et facultatif (seulement si cela peu permettre d'accélérer la macro)

Je sais que les fichiers voulu commencerons toujours par "616".

Et donc au final récupérer la liste des fichiers du dossier et des sous dossier dans une feuille "données" comme dans la première version.

Merci d'avance pour ta réponse, ou a la personne de passage qui comprendrait le code de Thev et qui saurait l'adapter

EDIT: ha j'oubliais, je ne sais pas combien de niveau de sous dossier il existe dans le dossier image. Il peut y avoir plusieur niveau.

Bonjour,

ci-dessous code :

Option Explicit

Sub liste_des_fichiers()

    Dim dossier_départ As Object, fichier As Object
    Dim images As String
    Dim fso As Object
    Dim tb_fichiers(): tb_fichiers = Array("")
    Dim i As Integer: i = 0

    '// dossier images de l'utilisateur
    images = Environ("USERPROFILE") & "\Pictures"

    '// création objet FilesSystem
    Set fso = CreateObject("Scripting.FilesystemObject")

    '// recherche des fichiers
    Set dossier_départ = fso.GetFolder(images)
    rech_fichier fso, dossier_départ, tb_fichiers, i

    '// recopie des fichiers dans la feuille Données
    If UBound(tb_fichiers) = -1 Then Exit Sub
    Sheets("Données").Columns("A").Clear
    Sheets("Données").Range("A1").Resize(UBound(tb_fichiers) + 1).Value = Application.Transpose(tb_fichiers)

End Sub

Sub rech_fichier(fso As Object, dossier As Object, tb(), i As Integer)
    Dim sous_dossier As Object, fichier As Object
    Const extension As String = "bmp"

    '// recherche fichiers
    For Each fichier In dossier.Files
        If fso.GetExtensionName(fichier.Path) = extension Then
            ReDim Preserve tb(i): tb(i) = fichier.Name
            i = i + 1
        End If
    Next

    '// recherche sous-dossier
    For Each sous_dossier In dossier.SubFolders
        rech_fichier fso, sous_dossier, tb, i
    Next

End Sub

Wow quel macro !!

Pressé de l'essayer ! Je vais faire un test demain ! Voir si j'arrive a changer comme il faut les variables sans provoquer d'erreur !

Un grand merci a toi Thev, c'est le genre de macro que je n'arriverais jamais a faire, même avec beaucoups d'apprentissage