Rechercher fichier txt - remplacer des caractères

kiki31140

XLDnaute Junior
Bonjour forum et meilleurs voeux à tous

Voici ma nouvelle problématique.
J'ai un dossier avec 10 repertoires et plus d'une cinquantaine de sous-repertoires
dans certains sous-repertoire, j'ai un fichier texte "test-info.txt" avec des une donnée FMxx

Je n'ai pas trouvé vraiment de code car beaucoup de sujet.
je voudrais faire une recherche dans ce dossier, de tous les fichiers texte et remplacer la donnée FMxx par la donnée écrite en B1 du meme type (FM547 par exemple)
j'arrive , par un scanne, à trouver tous les fichier txt, par contre, je ne trouve pas d'info pour l'ouvrir, remplacer les caractères, puis sauvegarder.

Par avance, merci et bon week-end
 

sousou

XLDnaute Barbatruc
Bonjour
Ca doit être jouable, mais il faudrait plus de précision sur la forme de ton fichier texte, et celle de ton fichier excel
Envoi des exemples
de plus envoi la structures des dossiers. y a t-il des sous répertoires dans les sous-répertoire ect...
 

job75

XLDnaute Barbatruc
Bonsoir kiki31140, sousou,
Code:
Sub FichierTexte()
Dim nomfichier$, modif$, fso As Object, sf As Object, sf1 As Object, f As Object, n&, a$()
nomfichier = "test-info.txt" 'à adapter
modif = [B1] '"FM547" 'à adapter
Set fso = CreateObject("Scripting.FileSystemObject")
For Each sf In fso.GetFolder(ThisWorkbook.Path).subfolders
    For Each sf1 In fso.GetFolder(sf.Path).subfolders
        For Each f In fso.GetFolder(sf1.Path).Files
            If f.Name = nomfichier Then
                Open f.Path For Input As #1 '1ère ouverture
                While Not EOF(1) 'EndOfFile: fin du fichier
                    n = n + 1
                    ReDim Preserve a(1 To n)
                    Line Input #1, a(n)
                    If a(n) Like "FM*" Then a(n) = modif
                Wend
                Close #1 '1ère fermeture
                Open f.Path For Output As #1 '2ème ouverture
                Print #1, Join(a, vbCrLf)
                Close #1 '2ème fermeture
            End If
Next f, sf1, sf
End Sub
Les fichiers "test-info.txt" doivent se trouver dans le 2ème niveau d'arborescence après le dossier du fichier Excel.

Le traitement séquentiel de chaque fichier est très rapide.

A+
 

sousou

XLDnaute Barbatruc
Bonjour job75 et kiki31
Sans réponse, je dépose quand même ma contribution pour le fun;) avec une analyse récursive des dossiers
Joint, un dossier compressé pour tester la configuration
 

Pièces jointes

  • test.zip
    16.3 KB · Affichages: 6

job75

XLDnaute Barbatruc
Bonjour kiki31140, sousou, le forum,
Code:
Const nomfichier$ = "test_info.txt" 'en minuscules par sécurité
Dim modif$, fso As Object 'mémorise les variables

Sub Dossiers()
Dim sf1 As Object, sf2 As Object, sf3 As Object, sf4 As Object, sf5 As Object
modif = [B1] 'à adapter
Set fso = CreateObject("Scripting.FileSystemObject")
Fichiers fso.GetFolder(ThisWorkbook.Path) 'niveau 0
For Each sf1 In fso.GetFolder(ThisWorkbook.Path).subfolders
    Fichiers sf1 'niveau 1
    For Each sf2 In fso.GetFolder(sf1.Path).subfolders
        Fichiers sf2 'niveau 2
        For Each sf3 In fso.GetFolder(sf2.Path).subfolders
            Fichiers sf3 'niveau 3
            For Each sf4 In fso.GetFolder(sf3.Path).subfolders
                Fichiers sf4 'niveau 4
                For Each sf5 In fso.GetFolder(sf4.Path).subfolders
                    Fichiers sf5 'niveau 5
Next sf5, sf4, sf3, sf2, sf1
Set fso = Nothing
End Sub

Sub Fichiers(sf As Object)
Dim f As Object, n&, a$(), p%
For Each f In fso.GetFolder(sf.Path).Files
    If LCase(f.Name) = nomfichier Then 'minuscules
        Open f.Path For Input As #1 '1ère ouverture
        n = 0
        While Not EOF(1) 'EndOfFile: fin du fichier
            n = n + 1
            ReDim Preserve a(1 To n)
            Line Input #1, a(n)
            p = InStr(a(n), "FM")
            If p Then a(n) = Left(a(n), p - 1) & modif
        Wend
        Close #1 '1ère fermeture
        Open f.Path For Output As #1 '2ème ouverture
        Print #1, Join(a, vbCrLf)
        Close #1 '2ème fermeture
    End If
Next
End Sub
Les fichiers de tous les niveaux de 0 à 5 sont étudiés.

Si l'on est sûr qu'il n'y a pas de fichiers textes au niveau x supprimer l'instruction Fichiers sfx 'niveau x

Fichiers zippés joints.

A+
 

Pièces jointes

  • test_info_kiki(1).zip
    23.5 KB · Affichages: 8

Discussions similaires

Réponses
6
Affichages
263