Parcourir fichier texte (.TXT) en VBA

Résolu
sancho12345
Messages postés
131
Date d'inscription
jeudi 21 mai 2009
Statut
Membre
Dernière intervention
18 mars 2012
- 13 févr. 2012 à 13:20
sancho12345
Messages postés
131
Date d'inscription
jeudi 21 mai 2009
Statut
Membre
Dernière intervention
18 mars 2012
- 14 févr. 2012 à 09:32
Bonjour,
Je sollicite ENCORE votre aide !!! J'aimerai copier toutes les lignes d'un fichier texte (.TXT) qui commencent par « MG » dans un autre fichier texte (.TXT) qui ce trouvera dans un autre répertoire.

La macro ci-dessous parcours tous les fichier texte (.TXT) du dossier et en copie chaque ligne commençant par « MG » mais elle ne fonctionne pas?.



Dim Doss As String
Dim fs As FileSearch
Dim i As Long
Dim fso
Dim fic
Dim ficLire
Dim Lignes() As String
Dim LigneAEcrire As String
Dim Lireligne As String

Doss = "C:\Fichier"

Set fs = Application.FileSearch
Set fso = CreateObject("Scripting.FileSystemObject")
Set fic = fso.CreateTextFile("C:\test\fichier_modifié.txt", True)


ReDim Lignes(1 To 1)
With fs
.NewSearch
.LookIn = Doss
.FileName = "*.txt"
.SearchSubFolders = True
.Execute
For i = 1 To .FoundFiles.Count ' Parcours de tous les dossiers
LigneAEcrire = ""
Do Until ficLire.atendofstream
Lireligne = ficLire.readline
If Left(Lireligne, 1) = "MG" Then
LigneAEcrire = LigneAEcrire & Lireligne & ";"
End If
Loop
Lignes(UBound(Lignes)) = LigneAEcrire
ReDim Preserve Lignes(1 To UBound(Lignes) + 1)
ficLire.Close
Next i
End With

For i = 1 To UBound(Lignes) - 1
fic.writeline Lignes(i)
Next i
fic.Close


Par contre il faudrait qu'il parcoure uniquement un fichier bien précis du répertoire.

Le tout en VBA excel.

Pourriez-vous m?aider.

Merci à tous et bonne journée !

22 réponses

Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
71
14 févr. 2012 à 09:10
code réutilisable facilement...

Private Sub ExtractLines(ByRef vsFichierIn As String, ByRef vsFichierOut As String, ByRef vsCritere As String)
Dim FileName As String
Dim Content As String
Dim iFile As Integer
Dim oFile As Integer
Dim oMatch As Object
    '# Va permettre nos modifications de texte
    With CreateObject("VbScript.Regexp")
        .MultiLine = True
        '# Lecture du contenu du fichier d'entrée
        iFile = FreeFile
        Open vsFichierIn For Binary Access Read As #iFile
            Content = Space$(LOF(iFile))
            Get #iFile, , Content
        Close iFile
        If LenB(Content) > 0 Then
            oFile = FreeFile
            Open vsFichierOut For Output As #oFile
            
            '# Matchera la ligne d'entete
            .Pattern = "^.+$"
            Print #oFile, .Execute(Content)(0)

            '# Matchera la ligne dont le premier champ correspond au critère
            .Pattern = "^" & vsCritere & "\s*\|.*$"
            .Global = True
            For Each oMatch In .Execute(Content)
                Print #oFile, oMatch
            Next
            
            Close #oFile
        End If
    End With
End Sub


Pour l'appel, faire un :

ExtractLines "c:\test\Fichier_IN.txt", "c:\test\Fichier_OUT.txt", "MG"


Renfield - Admin CodeS-SourceS - MVP Visual Basic & Spécialiste des RegExp
3