Exécuter une Macro sur l’ensemble des fichiers TEXT

Bonjour à toutes et à tous.

Voici mon problème : J’aimerai exécuter une "Macro EXCEL" sur l’ensemble des fichiers "TEXTE" présents dans un même dossier.

Explication :

_ Un dossier "Photo" contient 3 fichiers "TEXTE" (1.txt, 2.txt, 3.txt).

_ Chaque fichier ".txt" est constitué exactement de la même façon :

- à la 3ième ligne est renseigné le "Nom"

- à la 6ième ligne est renseigné le "Prenom".

Je voudrai donc que ces informations soient importées dans une feuille EXCEL de la manière suivante :

Prenom (6ième ligne de 1.txt)
2Nom (3ième ligne de 2.txt)Prenom (6ième ligne de 2.txt)
3Nom (3ième ligne de 3.txt)Prenom (6ième ligne de 3.txt)

Voici les "Macro" que j’exécute, indépendamment l’une après l’autre, malheureusement!!

J’aimerai justement les synthétiser en "une seule et unique Macro EXCEL" et y rejouter de quoi traiter tous les Fichier ".txt" (présent dans le dossier "Photo") d'un coup!

Pour importer le "Nom"Pour importer le "Prenom"
Sub Nom()

Dim ifile As Integer

ifile = FreeFile

Dim x As Long

Dim Data As String

Open "D:\Photo\1.txt" For Input As #ifile

x = 1

Do While Not EOF(1)

Line Input #ifile, Data

If x = 3 Then Cells(1, 1) = Data

x = x + 1

Loop

Close #ifile

End Sub

Sub Prenom()

Dim ifile As Integer

ifile = FreeFile

Dim x As Long

Dim Data As String

Open "D:\Photo\1.txt" For Input As #ifile

x = 1

Do While Not EOF(1)

Line Input #ifile, Data

If x = 6 Then Cells(1, 2) = Data

x = x + 1

Loop

Close #ifile

End Sub

Merci beaucoup pour l’aide que vous pourrez m’apporter.

Bonjour Bat'ian, bonjour le forum,

Essaie comme ça. Code à placer dans le fichier qui recevra les données :

Sub Macro1()
Dim CD As Workbook
Dim OD As Worksheet
Dim FD As FileDialog
Dim ifile As Integer
Dim x As Long
Dim Data1 As String
Dim Data2 As String
Dim DL As Long

Set CD = ThisWorkbook
Set OD = CD.Worksheets(1)
Set FD = Application.FileDialog(msoFileDialogFolderPicker) 'permet de sélectionner le dossier
FD.AllowMultiSelect = False 'pas de sélection multiple
FD.Show
If FD.SelectedItems.Count = 0 Then Exit Sub
CH = FD.SelectedItems(1) & "\"
F = Dir(CH & "*.txt")
Do While F <> ""
    ifile = FreeFile
    DL = IIf(OD.Range("A1").Value = "", 1, OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1)
    Open CH & F For Input As #ifile
    x = 1
    Do While Not EOF(1)
        Line Input #ifile, Data
        If x = 3 Then OD.Cells(DL, 1) = Data
        If x = 6 Then OD.Cells(DL, 2) = Data
        x = x + 1
    Loop
    Close #ifile
    F = Dir
Loop
End Sub

Je t'avoue que je maîtrise pas du tout l'extraction des données d'un fichier TXT mais j'ai testé et ça fonctionne...

Merci beaucoup. Je teste ça et je vous dis.

Bonjour ThauThème.

Je vous remercie encore pour voter aide et cette macro.

J'ai rencontre malgré tout un problème quant à l’exécution de celle-ci.

En effet, cette ce programme me permet bien de sélectionner un dossier, mais lorsque j'en sélectionne "un" (mon dossier par exemple) je ne vois pas mes fichiers ".txt" dedans . Ce dossier m'apparait comme "vide" alors qu'il y a bien des fichiers ".txt "dedans.

Je ne vois pas comment résoudre ce problème.

Cordialement.

Bonjour Bat'ian

et y rejouter de quoi traiter tous les Fichier ".txt" (présent dans le dossier "Photo") d'un coup!

Donc il te suffit de sélectionner le dossier voulu. Tu n'as pas besoin de connaître les noms des fichiers puisque tu les veux tous (les txt). Je ne vois pas où est le problème !?...

On peut coder différemment mais alors il te faudra sélectionner les fichiers les uns après les autre, donc pour moi, beaucoup moins efficace...


Re,

Le même code où tu vois les fichiers mais tu dois les sélectionner dans la liste pour agir sur eux. Franchement, si c'est toujours TOUS LES FICHIERS, je préfère le premier code...

Sub Macro1()
Dim CD As Workbook
Dim OD As Worksheet
Dim FD As FileDialog
Dim I As Integer
Dim ifile As Integer
Dim x As Long
Dim Data1 As String
Dim Data2 As String
Dim DL As Long

Set CD = ThisWorkbook
Set OD = CD.Worksheets(1)
Set FD = Application.FileDialog(msoFileDialogFilePicker) 'permet de sélectionner le dossier
FD.AllowMultiSelect = True 'sélection multiple autorisée
FD.Filters.Add "csv files", "*.csv"
FD.Show
If FD.SelectedItems.Count = 0 Then Exit Sub
For I = 1 To FD.SelectedItems.Count
    ifile = FreeFile
    DL = IIf(OD.Range("A1").Value = "", 1, OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1)
    Open FD.SelectedItems(I) For Input As #ifile
    x = 1
    Do While Not EOF(1)
        Line Input #ifile, Data
        If x = 3 Then OD.Cells(DL, 1) = Data
        If x = 6 Then OD.Cells(DL, 2) = Data
        x = x + 1
    Loop
    Close #ifile
Next I
End Sub

Je suis sincèrement désolé de t’embêter ainsi.

Je dois surement mal m’exprimer et je manque aussi de pratique c'est sur.

Malheureusement, dans mon cas, cette Macro ne s’exécute pas.

Voici le "pas à pas" :

Étape 1 : Sub MacroExcel()

Étape 2 : Set CD = ThisWorkbook

Étape 3 : Set OD = CD.Worksheets(1)

Étape 4 : Set FD = Application.FileDialog(msoFileDialogFolderPicker) 'permet de sélectionner le dossier

Étape 5 : FD.AllowMultiSelect = False 'pas de sélection multiple

Étape 6 : FD.Show

Étape 7 : Je sélectionne mon dossier "photo"

Étape 8 : Sub MacroExcel() (Je retourne au départ!!)

En fait, la Macro applique le ligne : " If FD.SelectedItems.Count = 0 Then Exit Sub ". Je ne rentre pas dans la boucle.

Je ne sais pas pourquoi mais pour tous les dossiers que je sélectionne, ils apparaissent tous vides également!

Puis-je te demander encore un peu d'aide?

Et oui, c'est bien tous les fichiers ".txt" que j'aimerai traiter d'un seul coup.

Cordialement

Re,

Tu ne m'embêtes pas Bat'ian !... J'aimerais moi aussi comprendre.

J'ai commenté le code pour que tu y vois plus clair. J'imagine que tu sélectionnes le dossier dans la liste puis tu cliques sur le bouton [OK] pour valider ta sélection ?

Dans ce cas, ce n'est pas la ligne :

If FD.SelectedItems.Count = 0 Then Exit Sub

qui pose problème puisque FD.SelectedItems.Count est égale à 1...

Si la boucle ne se fait pas c'est à cause de :

Do While F <> ""

et cela signifie que le dossier choisi ne contient aucun fichier ayant une extension .txt.

Mais moi je n'ai pas tes fichiers ni tes dossiers et je ne peux pas vérifier à ta place !...

En revanche si je crée 4 fichiers .txt dans un même dossier, ayant chacun un nom en ligne 3 est un prénom en ligne 6, je te garantie qu'à la fin de la macro je me retrouve avec un tableau de 4 lignes et deux colonnes reprenant les noms/prénoms de chaque fichier...

Le code Full comment :

Dim ifile As Integer 'déclare la variable ifile
Dim x As Long 'déclare la variable x (incrément)
Dim Data As String 'déclare la variable data
Dim PLV As Long 'décalre la variable PLV (Première Ligne Vide)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD
Set FD = Application.FileDialog(msoFileDialogFolderPicker) 'définit la boîte de dialogue qui permet de sélectionner des dossiers
FD.AllowMultiSelect = False 'n'autorise pas de sélection multiple (donc un seul dossier)
FD.Show 'affiche la boîte de dialogue
If FD.SelectedItems.Count = 0 Then Exit Sub 'si bouton [Annuler] ou aucun dossier sélectionné, sort de la procédure

CH = FD.SelectedItems(1) & "\" 'définit le chemin d'accès CH du dossier sélectionné
F = Dir(CH & "*.txt") 'définit le premier ficher F (avec txt comme extension) du dossier sélectionné
Do While F <> "" 'boucle tant qu'il existe des fichiers F (<== c'est ici que ça ce passe*)
    '*****************************************************************************************
    'si le dossier ne contient aucun fichier avec l'extension "txt" la boucle ne s'exécute pas
    '*****************************************************************************************

    ifile = FreeFile 'définit la variable ifile
    'définit la ligne PLV (1 si A1 est vide, sinon la ligne de la première cellule vide de la colonne A de l'onglet OD)
    PLV = IIf(OD.Range("A1").Value = "", 1, OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1)
    Open CH & F For Input As #ifile 'ouvre le fichier F du dossier CH
    x = 1 'initialise la ligne x
    Do While Not EOF(1) 'exécute tant que (là je sais pas !... Je te laisse le soin de commenter)
        Line Input #ifile, Data 'récupère dans la variable Data le texte de la ligne x
        If x = 3 Then OD.Cells(PLV, 1) = Data 'si x = 3 renvoie le texte de Data dans la cellule ligne PLV, colonne 1
        If x = 6 Then OD.Cells(PLV, 2) = Data 'si x = 6 renvoie le texte de Data dans la cellule ligne PLV, colonne 1
        x = x + 1 'incrément x
    Loop 'boucle
    Close #ifile 'ferme le fichier F

    F = Dir 'définit le prochain fichier F (avec txt comme extension) du dossier sélectionné
Loop 'boucle
End Sub
Rechercher des sujets similaires à "executer macro ensemble fichiers text"