Exportation de plusieurs fichiers .txt dans différents dossiers vers un fichier [Résolu]

Signaler
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007
-
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007
-
Bonjour,

Pouvez vous me dire s'il est possible de récupérer des données se trouvant dans plusieurs fichiers au format txt ( le chemin est le meme il n'y a que le lecteur qui change) et d'intégrer les données dans un fichier excel.

En parcourant le forum j'ai trouvé quelques exemples mais uniquement pour 1 fichier.

Merci d'avance de vos réponses

9 réponses

Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 Bonsoir,

Ci-dessous, un exemple, que je viens de m'amuser à faire en vbs.
Il devrait être facilement adaptable en VB6.
C'est un peu brouillon, mais j'ai testé, avec réussite, sur 3 fichiers.
Ce code ne demande qu'à être optimisé.
La partie "Excel" n'est pas de moi. Plusieurs variables peuvent être supprimées.

jean-marc

'
'Objet de ce script:
'- Création d'un fichier résultat (.txt) contenant en append le contenu de 3 fichiers .txt
'  ayant le même nom, mais se trouvant sur des drivers ou folders différents;
'- Le fichier resultat (.txt) et le fichier Excel (.xls) sont créés dans le
'  répertoire courant (celui du script)
'- Export de ce fichier résultat (.txt) dans un nouveau fichier Excel (.xls).
'
'Option Explicit
Dim Path(3), fichier, MyPath, FicOut_1,FicOut_2, RepCourantConst ForReading 1, ForWriting 2, ForAppending=8
fichier = "test1.txt"
Path(0) = Cstr("c:")
Path(1) = Cstr("d:")
Path(2) = Cstr("d:\test1")
FicOut_1 = "test_resultat.txt"
FicOut_2 = "test_resultat.xls"


MyPath = Array(Path(0), Path(1), Path(2))
RepCourant = GetPath()
'############
'############ Partie1: Création du fichier résultat (.txt)
'############
Dim Fso, i, ObjTextStream0
Set Fso = CreateObject("Scripting.FileSystemObject")
'Création et ouverture du fichier résultat (.txt)
Set ObjTextStream0 = Fso.OpenTextFile(RepCourant & FicOut_1, 2, True)


'Lecture du Tableau
For i = LBound(MyPath) To UBound(MyPath)
    Dim ObjTextStream1, Contenu
    If Fso.FileExists(MyPath(i) & fichier) Then
       'MsgBox MyPath(i) & fichier & " existe !!!"
       'Ouverture en lecture du fichier issu du tableau
       Set ObjTextStream1 = Fso.OpenTextFile(MyPath(i) & fichier, 1)
       Contenu = ObjTextStream1.ReadAll
       'Fermeture du fichier en entrée
       ObjTextStream1.Close
       'Ecriture du fichier resultat (.txt)
       ObjTextStream0.Write Contenu
       'Suppression de l'objet
       Set ObjTextStream1 = Nothing
       End If
Next
ObjTextStream0.Close
Set ObjTextStream0 = Nothing


'############
'############ Partie2: Création du fichier résultat (.xls)
'############
Dim ObjExcel
Set ObjExcel = WScript.CreateObject("EXCEL.Application")
ObjExcel.Visible = True
ObjExcel.Workbooks.Add


Dim ObjTextStream, strtmp, NL, ExcelFile
Set ObjTextStream = Fso.OpenTextFile(RepCourant & FicOut_1, 1, False)
Do While Not ObjTextStream.AtEndOfStream
'MsgBox RepCourant & FicOut_1
NL = 1
strtmp = Split(ObjTextStream.ReadAll, vbCrLf)
For i = 0 To UBound(strtmp)
    'MsgBox strtmp(i)
    Cellule NL, 1, "'" & strtmp(i) , True, False, 10
    NL = NL + 1
   
Next
Loop
ObjTextStream.Close


 


ObjExcel.Columns("A:A").Select
ObjExcel.Selection.Columns.AutoFit
ObjExcel.Range("A1").Select
'MsgBox GetPah() & FicOut_2
ExcelFile=RepCourant & FicOut_2
If Fso.FileExists(ExcelFile) Then Fso.DeleteFile ExcelFile, True
ObjExcel.ActiveWorkBook.SaveAs ExcelFile
ObjExcel.ActiveWorkBook.Saved = True


Set ObjExcel = Nothing
Set ObjTextStream = Nothing
Set Fso = Nothing
MsgBox "fin du script"
'############
'############ Gestion des Fonctions
'############
'Récupère le répertoire courant
Function GetPath()
Dim path
path = WScript.ScriptFullName
'On ne garde que ce qui est à gauche du dernier slash (compris)
GetPath = Left(path, InStrRev(path, ""))
End Function
'
Sub Cellule(NumL,NumC,chaine,casse,italic,size)
objExcel.Cells(NumL,NumC).Value=Chaine


If casse or size <> 0 Then
'  Coords=CellName(NumL,NumC)
'  objExcel.Range(Coords & ":" & Coords).Select
   'If casse     Then objExcel.Selection.Font.Bold=True
   If italic    Then objExcel.Selection.Font.Italic=True
   If size <> 0 Then objExcel.Selection.Font.Size=size
End If
End Sub
'--------------------------------------------------------------------
'Function CellName(NumL,NumC)
'If NumC <= 26 Then
'            anumc=chr(64+NumC)
'Else
'            n1=int(NumC/26)
'            n2=NumC-n1*26
'            anumc=chr(64+n1)& chr(64+n2)
'End If
'CellName=anumc & NumL
'End Function
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 Re,

Erreur flagrante:
il manque le ""
Path(0) = Cstr("c:\Dossier1 \ ")
Path(1) = Cstr("c:\Dossier2\")
Path(2) = Cstr("c:\Dossier3\")

jean-marc
Messages postés
7741
Date d'inscription
mercredi 1 septembre 2004
Statut
Membre
Dernière intervention
24 septembre 2014
37
Ce que tu fais pour un fichier, il suffit de le répéter ensuite pour chacun des fichiers à traiter.

Au pire tu le mets dans une fonction à laquelle tu passe en paramètres le chemin du fichier à traiter.
Puis tu fais une boucle pour appeler ta fonction avec chacun des chemins des différents fichiers à traiter.

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007

Sinon je viens de penser à un truc, ne serait il pas plus simple de récupérer le contenu de tous les fichiers .txt et ensuite de l'exporter vers Excel ?


Si oui pouvons nous récupérer via un script VB le contenu de ces fichiers .txt pour n'en faire qu'un ?
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007

merci beaucoup !!
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007

Par contre je rencontre un petit soucis, le fichier txt et donc le xls sont vide comme si rien ne s'enregistrait ......
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 Bonjour,

Post ton code modifié pour voir si je trouve une anomalie !!!
Quand que ton script n'est pas opérationnel, n'hésite pas à mettre
des traces au-dessous de chaque ligne significative.
msgbox "vérif_1 " & var1
msgbox "vérif_2" &vbCrLF& "ma var1 contient: " &  var1 &vbCrLf&_
             "ma var2 contient: " & var2
etc....

jean-marc
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007

(re) Bonjiour

Alors en fait j'ai recopié le script que tu as fait et j'ai uniquement changé les variables
Path(0) = Cstr("c:")
Path(1) = Cstr("d:")
Path(2) = Cstr("d:\test1")
FicOut_1 = "test_resultat.txt"
FicOut_2 = "test_resultat.xls"

en

Path(0) = Cstr("c:\Dossier1")
Path(1) = Cstr("c:\Dossier2")
Path(2) = Cstr("c:\Dossier3")
FicOut_1 = "result.txt"
FicOut_2 = "result.xls"

afin de faire le test en local sur ma machine

ce qui donne ceci :
Option Explicit
Dim Path(3), fichier, MyPath, FicOut_1,FicOut_2, RepCourantConst ForReading 1, ForWriting 2, ForAppending=8
fichier = "test1.txt"
Path(0) = Cstr("c:\Dossier1")
Path(1) = Cstr("c:\Dossier2")
Path(2) = Cstr("c:\Dossier3")
FicOut_1 = "result.txt"
FicOut_2 = "result.xls"


MyPath = Array(Path(0), Path(1), Path(2))
RepCourant = GetPath()
'############
'############ Partie1: Création du fichier résultat (.txt)
'############
Dim Fso, i, ObjTextStream0
Set Fso = CreateObject("Scripting.FileSystemObject")
'Création et ouverture du fichier résultat (.txt)
Set ObjTextStream0 = Fso.OpenTextFile(RepCourant & FicOut_1, 2, True)


'Lecture du Tableau
For i = LBound(MyPath) To UBound(MyPath)
    Dim ObjTextStream1, Contenu
    If Fso.FileExists(MyPath(i) & fichier) Then
       MsgBox MyPath(i) & fichier & " existe !!!"
       'Ouverture en lecture du fichier issu du tableau
       Set ObjTextStream1 = Fso.OpenTextFile(MyPath(i) & fichier, 1)
       Contenu = ObjTextStream1.ReadAll
       'Fermeture du fichier en entrée
       ObjTextStream1.Close
       'Ecriture du fichier resultat (.txt)
       ObjTextStream0.Write Contenu
       'Suppression de l'objet
       Set ObjTextStream1 = Nothing
       End If
Next
ObjTextStream0.Close
Set ObjTextStream0 = Nothing


'############
'############ Partie2: Création du fichier résultat (.xls)
'############
Dim ObjExcel
Set ObjExcel = WScript.CreateObject("EXCEL.Application")
ObjExcel.Visible = True
ObjExcel.Workbooks.Add


Dim ObjTextStream, strtmp, NL, ExcelFile
Set ObjTextStream = Fso.OpenTextFile(RepCourant & FicOut_1, 1, False)
Do While Not ObjTextStream.AtEndOfStream
MsgBox RepCourant & FicOut_1
NL = 1
strtmp = Split(ObjTextStream.ReadAll, vbCrLf)
For i = 0 To UBound(strtmp)
    MsgBox strtmp(i)
    Cellule NL, 1, "'" & strtmp(i) , True, False, 10
    NL = NL + 1


Next
Loop
ObjTextStream.Close


 


ObjExcel.Columns("A:A").Select
ObjExcel.Selection.Columns.AutoFit
ObjExcel.Range("A1").Select
'MsgBox GetPah() & FicOut_2
ExcelFile=RepCourant & FicOut_2
If Fso.FileExists(ExcelFile) Then Fso.DeleteFile ExcelFile, True
ObjExcel.ActiveWorkBook.SaveAs ExcelFile
ObjExcel.ActiveWorkBook.Saved = True


Set ObjExcel = Nothing
Set ObjTextStream = Nothing
Set Fso = Nothing
MsgBox "fin du script"
'############
'############ Gestion des Fonctions
'############
'Récupère le répertoire courant
Function GetPath()
Dim path
path = WScript.ScriptFullName
'On ne garde que ce qui est à gauche du dernier slash (compris)
GetPath = Left(path, InStrRev(path, ""))
End Function
'
Sub Cellule(NumL,NumC,chaine,casse,italic,size)
objExcel.Cells(NumL,NumC).Value=Chaine


If casse or size <> 0 Then
'  Coords=CellName(NumL,NumC)
'  objExcel.Range(Coords & ":" & Coords).Select
   'If casse     Then objExcel.Selection.Font.Bold=True
   If italic    Then objExcel.Selection.Font.Italic=True
   If size <> 0 Then objExcel.Selection.Font.Size=size
End If
End Sub
'--------------------------------------------------------------------
Function CellName(NumL,NumC)
If NumC <= 26 Then
            anumc=chr(64+NumC)
Else
            n1=int(NumC/26)
            n2=NumC-n1*26
            anumc=chr(64+n1)& chr(64+n2)
End If
CellName=anumc & NumL
End Function

Voila et merci beaucoup de ton aide :-)

Pour info les fichiers txt contiennent des info du type :

Nom serveur
Date
Résultat sauvegarde
Réussie.

L'objectif est donc de récolter dans le fichier excel les txt sur chaque serveur et de regrouper le résultat dans le fichier excel.

PS: j'utilise VBS au lieu de VB6

Encore merci
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007

Merci pour m'avoir ouvert les yeux pour cette erreure en effet évidente.


Comment ai je pu les oublié , merci encore c'est super ça marche