Probleme de memoire

Bonjour à tous,

je suis sur un exercice dans lequel

• j'ouvre un dossier
• j'ouvre chaque dossier text du fichier
• je met en place un compteur pour connaitre le nombre de fichier ouvert

Il y a 74000 fichiers a traité hors la boucle s'arret au 2400e fichier

je voulais donc savoir si avec cette macro les fichiers reste en mémoire?

merci d'avance

Sub compteur()

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

Next f 'prochain fichier de la boucle

End Sub

Bonjour,

Vous ne devriez pas ouvrir chaque fichier pour lire le contenu,

voici un exemple,

Sub test_lire()
'ajouter la référence Microsoft Scripting Runtime
Dim oFl As Scripting.file
Dim oTxt As Scripting.TextStream
Dim texte()
Dim i As Integer
fileName = "C:\MonFichier_test_lire.txt" '<--à adapter
Set oFSO = New Scripting.FileSystemObject
Set oFl = oFSO.GetFile(fileName)
Set oTxt = oFl.OpenAsTextStream(ForReading)
  While Not oTxt.AtEndOfStream
   i = i + 1
   ReDim Preserve texte(i)
   texte(i) = oTxt.ReadLine
  Wend
  Sheets("Feuil1").[A1].Resize(UBound(texte)) = Application.Transpose(texte)
End Sub

sabV vous êtes un amour de répondre aussi rapidement.

est ce que je peux vous demander quelques explications sur ce code?

est ce que je peux vous demander quelques explications sur ce code?

oui

Sub test_lire()

'ajouter la référence Microsoft Scripting Runtime

Dim oFl As Scripting.file

Dim oTxt As Scripting.TextStream

Dim texte()

Dim i As Integer

fileName = "C:\MonFichier_test_lire.txt" '<--à adapter je vois que sur cette ligne c'est un nom de fichier l'objectif de ma macro c'est de bouclé sur chaque fichier afin de faire des vérifications de données et de les traités si celle-ci sont vrai. hors sur cette ligne il faut identifié un fichier precis? est ce bien cela?

Set oFSO = New Scripting.FileSystemObject

Set oFl = oFSO.GetFile(fileName)

Set oTxt = oFl.OpenAsTextStream(ForReading)

While Not oTxt.AtEndOfStream

i = i + 1

ReDim Preserve texte(i)

texte(i) = oTxt.ReadLine

Wend

Sheets("Feuil1").[A1].Resize(UBound(texte)) = Application.Transpose(texte)

End Sub

pour une boucle sur chaque fichiers du répertoire choisi,

Sub Test_Lire_Fichiers_Texte()
'ajouter la référence Microsoft Scripting Runtime
Dim fd As FileDialog, rw As Long, lignes, i
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.AllowMultiSelect = False
oFolder = fd.SelectedItems(1)
rw = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set sfoFolder = fso.GetFolder(oFolder)

    For Each oFile In sfoFolder.Files
        Open oFile For Binary As #ff
        Temp = String(FileLen(oFile), " ")
        Get #ff, , Temp ' Récupère tout le fichier
        Close #ff
        lignes = Split(Temp, vbCrLf)

            For i = LBound(lignes) To UBound(lignes)
              rw = Cells(Rows.Count, 1).End(xlUp).Row + 1
              Cells(rw, 1) = lignes(i)
            Next i
    Next
End Sub

désolé mais je ne comprend pas ce code...

Bonjour,

Un autre exemple dans le même esprit mais avec la fonction Dir(). Les commentaires sont dans le code :

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 1\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
            Range(Cells(I, 1), Cells(I, UBound(Tbl))).Value = Tbl

        Close #1

        'au suivant...
        Fichier = Dir()

    Loop

End Sub

merci Theze pour ton retour, je me bas pour trouver des solutions ^^

je voulais savoir si je veux récupéré des données en fonction d'une méthode find sur la colonne A pour les renvoyer sur une autre feuille?

j'ai essayé d'appliquer une action dans la boucle mais rien alors que si je met une action juste après la boucle pas de soucis.

Pour info je test un petit msgbox pour voir si l'action est prise en compte....

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 1\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

Range(Cells(I, 1), Cells(I, UBound(Tbl))).Value = Tbl

'si je met un msg box ici rien ne se passe.

Close #1

'au suivant...

Fichier = Dir()

Loop

'si je met une msgbox ici le msgbox s'affiche.

End Sub

Re,

Voici le code avec des boites de messages (j'ai aussi mis une gestion des fichiers contenant qu'une seule ligne). Utilises les balise Code, le bouton </> (mettre le code entre les deux balises) :

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