Problème de ram dans une boucle vba

Version imprimable

Bonjour les amis,
je rencontre un petit soucis sur une macros.
J'ai un dossier dans lequel j'ai 74000 fichiers.
je veux y faire quelque recherche (methode find)puis classé les valeurs dans un autre fichier.xlsm.
Le soucis c'est que sur chaque ouverture de fichier la mémoire s'agrandit et arrive a saturation au bout du 2400e fichier traiter.
Je ferme chaque fichier ouvert une fois la boucle de traitement fini mais la ram continue d'augmenter.
Je cherche une raison à cela mais je ne trouve rien je viens donc faire appelle à vos compétence.

voici la macro que j'ai réalisé.
A savoir la partie compteur de boucle, je l'ai mise simplement pour savoir sur quel numero de fichier traité la boucle bug.
merci d'avance les amis.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 Sub lok() Dim sf As Object 'déclare la variable sf (Système de Fichiers) Dim ca As String 'déclare la variable ca (Chemin d'Accès) Dim d As Object 'déclare la variable d (Dossiers) Dim fs As Object 'déclare la variable fs (FichierS) Dim f As Object 'déclare la variable f (Fichier) Dim cl As Workbook 'déclare la variable cl (CLasseur) Dim exercice As Workbook 'déclare la variable exercice 'variable code de traitement Dim c As Range Dim TaValeur As String Application.ScreenUpdating = False ca = "C:\wamp64\www\annuaire_mairie\annuaire_txt" 'définit le chemin d'accès (à adapter à ton cas)' Set sf = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers sf Set d = sf.GetFolder(ca) 'définit le dossier d Set fs = d.Files 'définit les fichiers fs For Each f In fs 'boucle sur tous les fichiers f Workbooks.Open (ca & "\" & f.Name) 'ouvre le fichier Set cl = ActiveWorkbook 'définit le classeur cl (la variable cl sera utilisée pour le traitement des données) 'ton code de traitement Workbooks("exercice.xlsm").Worksheets("traitement").Range("a2") = Workbooks("exercice.xlsm").Worksheets("traitement").Range("a2").Value + 1 cl.Close SaveChanges:=FalseThen Set cl = Nothing Next f 'prochain fichier de la boucle End Sub

Bonsoir, une idée! Vous pourriez essayer la modification en rouge.

Code:

1
2
3
4
5
6
7
8
9
 
Code........
Workbooks("exercice.xlsm").Worksheets("traitement").Range("a2") = Workbooks("exercice.xlsm").Worksheets("traitement").Range("a2").Value + 1
     Set cl = Nothing
      ActiveWorkbook.Close SaveChanges:=FalseThen
    
Next f 'prochain fichier de la boucle
 
End Sub

Cordialement 8-)

29/04/2018, 20h36
unparia

Bonjour
J'ai "adoré" la constante FalseThen
J'imagine qu'elle doit avoir un rapport avec cette ligne commentée :

Code:

'ton code de traitement

et le nom Tavaleur choisi pour une variable.

Pour être sérieux : un classeur auquel on apporte mille et une modifications sans le sauvegarder est un classeur gourmand en mémoire (il doit de surcroît mémoriser toutes les modifications dans un fichier temporaire). Si l'on veut le soulager, il faut le sauvegarder de temps à autre.

EDIT :

Citation:

J'ai un dossier dans lequel j'ai 74000 fichiers.
je veux y faire quelque recherche

Et je n'ose même pas penser à la présence éventuelle, parmi ce tas-là, d'un fichier naturellement énorme ou devenu énorme à la suite d'un accident d'adressage sur le disque dur ou encore non exploitable par Excel. (et je ne vois aucun garde-fou dans le code montré).
29/04/2018, 22h48
IMS64

re

Salut à tous,
en fait je procède étape par étape pour monter ma macro et je règle chaque problème rencontré au fur et à mesure.
Pour le coup j'ai ajouté un "doevent" a la fin de la boucle et du coup je n'ai plus la mémoire qui se charge.
Je me demande si pour le coup le fait est d'utiliser doevent ne va pas ralentir ma macro...
et j'ai corriger la variable que j'incrémente de integer a long sinon je rencontre une erreur au fichier 32000...
en tous cas je continue à m'accrocher et je vous remercie pour temps.:yaisse:
30/04/2018, 07h22
Theze

Bonjour,

Donc, les codes donnés dans l'autre forum, on laisse tomber ? Tu ouvres des fichiers texte dans Excel alors qu'il est plus rapide et moins gourmand de récupérer les valeurs avec un "Open...Close" !
30/04/2018, 07h26
unparia

Bonjour Theze

Citation:

Donc, les codes donnés dans l'autre forum, on laisse tomber ? Tu ouvres des fichiers texte dans Excel alors qu'il est plus rapide et moins gourmand de récupérer les valeurs avec un "Open...Close" !

Ton intervention nous apprend ce que IMS64 s'est abstenu de nous préciser : il s'agit finalement de simples fichiers texte !

EDIT : c'est donc bien ce que je pensais (mon message plus haut) : jeu de ping-pong entre deux sites, avec des bouts de copié/collé et des fautes ajoutées.
Et c'est, je suppose, le même qui m'a mis un pouce rouge anonyme ;) :zzz:
30/04/2018, 08h00
IMS64

re

unparia ???
30/04/2018, 08h06
IMS64

re

salut Thèze
j'ai essayé de comprendre l'open close mais je n'ai pas réussi..
et effectivement je cherche des solutions partout ou je peux en trouver.

et pour info JE NE MET PAS DE POUCE ROUGE EN ANONYME...:ptdr:

Bonjour tout le monde, unparia,

Les critiques, d'où qu'elles viennent, sont constructives, à mon sens, il n'y a pas à sanctionner mais bon, pour certains, elles sont mal prises !

Le dernier code posté était :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
Sub Test()
 
    Dim Tbl
    Dim I As Integer
    Dim Tampon As String
    Dim Dossier As String
    Dim Fichier As String
 
    'chemin du dossier à adapter
    Dossier = "E:\Dossier \Dossier 2\"
 
    'tous les fichiers texte du dossier
    Fichier = Dir(Dossier & "*.txt")
 
    'boucle sur ces derniers...
    Do While (Len(Fichier) > 0)
 
    'ouvre le fichier en mode binaire
    Open Dossier & Fichier For Binary As #1
 
        'dimensionne le tampon pour qu'il puisse recevoir
        'le contenu du fichier texte en cours puis récup !
        Tampon = Space$(LOF(1))
        Get #1, , Tampon
 
        'splite le fichier par ligne
        Tbl = Split(Tampon, vbCrLf)
 
        'réparti les valeur sur les colonnes ligne par ligne dans la feuille active à partir de A1
        I = I + 1
 
        If UBound(Tbl) > 0 Then Range(Cells(I, 1), Cells(I, UBound(Tbl))).Value = Tbl Else Cells(I, 1).Value = Tbl
 
        MsgBox "Nom du fichier en cours : " & Fichier _
               & vbCrLf & _
               "Nombre de caractères : " & Len(Tampon)
 
 
    Close #1
 
    'au suivant...
    Fichier = Dir()
 
    Loop
 
    MsgBox "Le dossier '" & Dossier & "' possède " & I & " fichiers !"
 
End Sub

Des boites de message ont été rajoutées car tu disais que les boites de message que tu avais ajouté au code initial ne s'affichait pas chez toi donc, ici, dans mon dernier code, elles s'affichent.

Les valeurs sont récupérées et mises ligne par ligne mais tu ne dis pas si c'est bon ou si tu les veux en colonne et dans ces valeurs si tu veux en récupérer certaines ?

bonjour
je ne vois aucun soucis dans cet exercice si ce n'est que il n'est pas prevu de gestion d'erreur en cas de gros fichiers text

@theze j'ai deplacé ton close pour fermer le tread du open le texte etant dans tampon il n'est pas necessaire de garder le fichier ouvertj'ai mis la ligne d'injection a ma sauce

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Test()
    Dim Tbl, I As Integer, Tampon As String, Dossier As String, Fichier As String
 
    Dossier = "C:\Users\polux\Desktop\"    'chemin du dossier à adapter
 
    Fichier = Dir(Dossier & "*.txt")    'tous les fichiers texte du dossier
 
    Do While (Len(Fichier) > 0)    'boucle sur ces derniers...
        Open Dossier & Fichier For Binary As #1    'ouvre le fichier en mode binaire
        'dimensionne le tampon pour qu'il puisse recevoir
        'le contenu du fichier texte en cours puis récup !
        Tampon = Space$(LOF(1))    'pas vraiment necessaire surtout qu'en cas de gros fichiers ca plante
        Get #1, , Tampon
        Close #1 'je deplace ici le close pour ne plus garder en memoire le tread du open
        Tbl = Split(Tampon, vbCrLf)    'splite le fichier par ligne
        'réparti les valeur sur les colonnes ligne par ligne dans la feuille active à partir de A1
        I = I + 1
        Cells(I, 1).Resize(1, IIf(UBound(Tbl) = 0, 1, UBound(Tbl))) = Tbl
        'compte rendu de l'operation dans la barre de status
        Application.StatusBar = "Nom du fichier en cours : " & Fichier & vbCrLf & "Nombre de caractères : " & Len(Tampon)
        'au suivant...
        Fichier = Dir()
    Loop
    Application.StatusBar = "Le dossier '" & Dossier & "' possède " & I & " fichiers !"
End Sub

01/05/2018, 10h30
Theze

Bonjour Patrick,

Citation:

j'ai deplacé ton close pour fermer le tread du open le texte etant dans tampon il n'est pas necessaire de garder le fichier ouvertj'ai mis la ligne d'injection a ma sauce

Tu as raison, il ne sert à rien de le garder en mémoire une fois la récup effectuée !