Macro pour traitement de fichiers Excel

fafardel

XLDnaute Nouveau
Bonjour à tous et merci pour votre travail.

D'habitude graçce au forum, j'arrive à trouver toutes mes réponses et/ou à les adapter pour mes besoins :p

j'ai besoin de vous pour la création d'une macro pour traiter des fichiers txt
Voici le descriptif du boulot que doit effectuer la Macro.

1 : Lister tous les fichiers TXT dans les sous-répertoires d'un dossier et m'inscrire dans une cellule le nom du fichier, le chemin d'accès et le nombre de lignes de ce fichier commençant par XM
==> Là, je bute vraiment sur cette partie.

2 : Ensuite importés tous les fichiers trouvés avec un formatage en séparateur |
==> Là j'ai trouvé comment importés un fichier TXT avec ce format mais je bloque quand il y a plusieurs fichiers TXT à importer.

3 : Ensuite je fais des transfromations sur ce fichier et là j'ai réussi tout ce que je voulai faire donc c'est nickel

4 : Et enfin, je voudrai ensuite enregistrer ce fichier avec le nom du répertoire ou ce fichier se trouvait avec un format d'enregistrement TXT avec séparateur |
du type XXXXX_final.txt

Merci beaucoup de votre aide

Fabien
 

fafardel

XLDnaute Nouveau
Re : Macro pour traitement de fichiers Excel

Bonjour et Merci pour ces liens
le problème c'est que ce classeur excel va être distribué sur plusieurs postes et c'est pas vraiment validé par le RSSI d'installer des couches supplémentaires à Excel.

Serait-il posible d'avoir un coup de main ou un exmple de code pour cette partie là :
Lister tous les fichiers TXT dans les sous-répertoires d'un dossier et m'inscrire dans une cellule le nom du fichier, le chemin d'accès et le nombre de lignes de ce fichier commençant par XM

Merci d'avance.
 

JNP

XLDnaute Barbatruc
Re : Macro pour traitement de fichiers Excel

Bonjour Fafardel, salut Bruno :),
Pas besoin de m'envoyer un MP pour ça :rolleyes:...
Regarde ce fil, en modifiant
Code:
Cells(I, 1) = Dossier.Name
par
Code:
Cells(I, 1) = Fichier.Path
tu vas déjà récupérer la liste des fichiers et leurs chemins.
Il suffit juste de rajouter un test avec Left(Fichier.Name, 2) = "XM" pour ne tenir compte que de ceux-la ;).
Par contre, je ne pense pas que le nombre de ligne fasse partie des propriétés, donc il va falloir tous les ouvrir pour le récupérer :p...
Je te conseille la méthode "Input #" à chercher dans l'aide VBA, tu pourras du coup t'en servir pour l'importation et pour l'enregistrement ;)...
Bon courage :cool:
 

JNP

XLDnaute Barbatruc
Re : Macro pour traitement de fichiers Excel

Re :),
Bon, avec ce code
Code:
Option Explicit
Dim I As Long
Sub Test()
Dim Chemin As String, Dossier As Object, SousDossier As Object, Fichier As Object
Chemin = "C:\Temp\"
I = 1
Application.ScreenUpdating = False
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
If Left(Fichier.Name, 2) = "XM" Then
Cells(I, 1) = Fichier.Name
Cells(I, 2) = Fichier.Path
If Right(Fichier.Name, 4) = ".txt" Then Cells(I, 3) = NbreLigne(Fichier.Path)
I = I + 1
End If
Next
ListeFichier (Chemin)
Application.ScreenUpdating = True
End Sub
Function ListeFichier(Chemin As String) As String
Dim Dossier As Object, SousDossier As Object, Fichier As Object
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each SousDossier In Dossier.SubFolders
ListeFichier (Chemin & SousDossier.Name & "\")
For Each Fichier In SousDossier.Files
If Left(Fichier.Name, 2) = "XM" Then
Cells(I, 1) = Fichier.Name
Cells(I, 2) = Fichier.Path
If Right(Fichier.Name, 4) = ".txt" Then Cells(I, 3) = NbreLigne(Fichier.Path)
I = I + 1
End If
Next
Next
End Function
Function NbreLigne(Chemin As String) As Integer
Dim MyString As String
Open Chemin For Input As #1
Do While Not EOF(1)
    Input #1, MyString
    NbreLigne = NbreLigne + 1
Loop
Close #1
End Function
en changeant le Chemin de départ, ton 1 devrait être entièrement résolu :p...
Bonne suite :cool:
 

fafardel

XLDnaute Nouveau
Re : Macro pour traitement de fichiers Excel

Merci de votre aide
J'ai adapté le code pour ne faire apparaitre que les fichiers qui étaient en format TXT
Maintenant, j'aimerai qu'une macro tourne en me récupérant le chemin du répertoire avec le nom du fichier TXT et me compte le nombre de ligne qui commence par XM et qu'ensuite cette macro ouvre tous les fichiers txt trouvés dans le repertoire et me les concaténe
Je sais je demande beaucoup de choses (enfin pour moi) mais cela m'éviterait pas mal de boulot pour traiter ces fichiers

Encore merci
 

JNP

XLDnaute Barbatruc
Re : Macro pour traitement de fichiers Excel

Re :),
Merci de votre aide
J'ai adapté le code pour ne faire apparaitre que les fichiers qui étaient en format TXT
Maintenant, j'aimerai qu'une macro tourne en me récupérant le chemin du répertoire avec le nom du fichier TXT et me compte le nombre de ligne qui commence par XM et qu'ensuite cette macro ouvre tous les fichiers txt trouvés dans le repertoire et me les concaténe
Je sais je demande beaucoup de choses (enfin pour moi) mais cela m'éviterait pas mal de boulot pour traiter ces fichiers

Encore merci
Euh, tu es sûr que tu as lu mon dernier message ?
Par contre, j'avais mal lu, pour moi c'était les fichiers qui devaient commencer par XM et non les lignes :rolleyes:...
Mais bon, il suffit juste de modifier la fonction
Code:
Function NbreLigne(Chemin As String) As Integer
Dim MyString As String
Open Chemin For Input As #1
Do While Not EOF(1)
    Input #1, MyString
    If Left(MyString, 2) = "XM" Then NbreLigne = NbreLigne + 1
Loop
Close #1
End Function
Après, concaténer des fichiers, je ne vois pas ce que ça veux dire :confused:... Si c'est les mettre en dessous les uns des autres, le Input ira très bien, tu pourras même ne mettre que les lignes avec XM :p...
Bon courage :cool:
 

fafardel

XLDnaute Nouveau
Re : Macro pour traitement de fichiers Excel

Bonjour JNP et Merci :)

Quand je lance la macro via Excel 2007, rien en se passe
Je n'ai pas de message d'erreur ou de fenêtre qui s'affiche

D'où cela peut - il provenir ?
Meric de ton aide encore une fois
 

fafardel

XLDnaute Nouveau
Re : Macro pour traitement de fichiers Excel

Bonjour JNP et encore merci

Oui j'ai changé le chemin d'extraction

Une petite question :
Excle permet il de manipuler des fichiers txt qui sont présents dans des dossiers différents
du style je mets mon fichier excel dans un dossier parent et il me scanne tous les fichiers TXT qui sont dans ce dossier et ses sous repertoires
Me compte le nombre de ligne XM dans chaque fichier
Me l'inscrit dans un onglet et ensuite manipule les fichiers txt correspondants par le reste de la macro

Merci de ton aide
 

JNP

XLDnaute Barbatruc
Re : Macro pour traitement de fichiers Excel

Re :),
C'est exactement ce que fait ma macro :p...
Seul bémol, comme je te l'ai dit, j'avais compris que tu ne voulais "que les fichiers commençant par XM" et non "le nombre de ligne commençant par XM" :rolleyes:...
Du coup, tu n'as pas ôté le test sur le début du nom de fichier ;)...
Voilà qui devrait aller mieux :
Code:
Option Explicit
Dim I As Long
Sub Test()
Dim Chemin As String, Dossier As Object, SousDossier As Object, Fichier As Object
Chemin = "C:\Temp\"
I = 1
Application.ScreenUpdating = False
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
Cells(I, 1) = Fichier.Name
Cells(I, 2) = Fichier.Path
If Right(Fichier.Name, 4) = ".txt" Then Cells(I, 3) = NbreLigne(Fichier.Path)
I = I + 1
Next
ListeFichier (Chemin)
Application.ScreenUpdating = True
End Sub
Function ListeFichier(Chemin As String) As String
Dim Dossier As Object, SousDossier As Object, Fichier As Object
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each SousDossier In Dossier.SubFolders
ListeFichier (Chemin & SousDossier.Name & "\")
For Each Fichier In SousDossier.Files
Cells(I, 1) = Fichier.Name
Cells(I, 2) = Fichier.Path
If Right(Fichier.Name, 4) = ".txt" Then Cells(I, 3) = NbreLigne(Fichier.Path)
I = I + 1
Next
Next
End Function
Function NbreLigne(Chemin As String) As Integer
Dim MyString As String
Open Chemin For Input As #1
Do While Not EOF(1)
    Input #1, MyString
    If Left(MyString, 2) = "XM" Then NbreLigne = NbreLigne + 1
Loop
Close #1
End Function
Bonne journée :cool:
 

fafardel

XLDnaute Nouveau
Re : Macro pour traitement de fichiers Excel

JNP, c'est super

Merci beaucoup

Pourrais - tu m'aider pour enregistrer le fichier final avec le séparateur | ?

Je n'y arrive pas tout le reste est parfait sauf cela et pas moyen de trouver

est ce que c'est parce que ce séparateur est une combinaison de touches ? (alt gr+6)

Merci de ton aide
Fabien
Je te joins ma macro :

Sub Enregistrement()
'Enregistrement du fichier en TXT
Dim Range As Object, Line As Object, Cell As Object
Dim StrTemp As String
Dim Separateur As String
Separateur = "|"
Filename = Application.GetSaveAsFilename("c:\temp\transfer_ok", "Text Files (*.txt), *.txt")
Set Range = ActiveSheet.UsedRange
Open Filename For Output As #1
For Each Line In Range.Rows
StrTemp = ""
I = 1
For Each Cell In Line.Cells
If I = Line.Cells.Count Then
StrTemp = StrTemp & CStr(Cell.Text)
Else
StrTemp = StrTemp & CStr(Cell.Text) & Separateur
End If
I = I + 1
Next
Print #1, StrTemp '= " "
Next
Close
End Sub
 
Dernière édition:

JNP

XLDnaute Barbatruc
Re : Macro pour traitement de fichiers Excel

Re :),
Bien compliqué tout ça, et les cellules sont des Range, pas des Object :rolleyes:...
Code:
Sub Enregistrement()
'Enregistrement du fichier en TXT
Dim Plage As Range
Dim StrTemp As String, NomFichier As String
Dim I As Integer, J As Integer
NomFichier = Application.GetSaveAsFilename("c:\temp\transfer_ok ", "Text Files (*.txt), *.txt")
Set Plage = ActiveSheet.UsedRange
Open NomFichier For Output As #1
For I = 1 To Plage.Rows.Count
    StrTemp = ""
    For J = 1 To Plage.Columns.Count
        StrTemp = StrTemp & CStr(Cells(I, J).Text) & Chr(124)
    Next J
    Print #1, Left(StrTemp, Len(StrTemp) - 1)
Next I
Close #1
End Sub
Bonne suite :cool:
 

fafardel

XLDnaute Nouveau
Re : Macro pour traitement de fichiers Excel

Désolé de revenir vers toi mais j'essaie de modfier ta macro qui fonctionne très bien mais je voudrai qu'elle s'exécute dans le dossier ou le fichier excel est enregistré

Sub Test()
Dim Chemin As String, Dossier As Object, SousDossier As Object, Fichier As Object
Chemin = "ThisWorkbook.path" ==> J'ai modifié cela
I = 1
Application.ScreenUpdating = False
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin) ==> Le chemin n'est pas bon il manque le signe \ sur le chemin du fichier final
For Each .txt In Dossier.Files
Cells(I, 1) = Fichier.Name
Cells(I, 2) = Fichier.Path
If Right(Fichier.Name, 4) = ".txt" Then Cells(I, 3) = NbreLigne(Fichier.Path)
I = I + 1
Next
ListeFichier (Chemin)
Application.ScreenUpdating = True
End Sub
Function ListeFichier(Chemin As String) As String
Dim Dossier As Object, SousDossier As Object, Fichier As Object
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each SousDossier In Dossier.SubFolders

Ou ai je commis l'erreur ThisWorkbook.Path ne peut pas être utilisé dans ce cas la ???
Merci de ton aide
 
Dernière édition:

Discussions similaires

Réponses
11
Affichages
462