Exportation de plusieurs fichiers .txt dans différents dossiers vers un fichier

Résolu
xl_squal_lx
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007
- 4 sept. 2006 à 13:56
xl_squal_lx
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007
- 7 sept. 2006 à 13:17
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

cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
5 sept. 2006 à 19:50
 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
3
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
7 sept. 2006 à 13:07
 Re,

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

jean-marc
3
cs_casy
Messages postés
7741
Date d'inscription
mercredi 1 septembre 2004
Statut
Membre
Dernière intervention
24 septembre 2014
41
4 sept. 2006 à 14: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 #
0
xl_squal_lx
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007

4 sept. 2006 à 15:03
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 ?
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

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

7 sept. 2006 à 10:31
merci beaucoup !!
0
xl_squal_lx
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007

7 sept. 2006 à 10:56
Par contre je rencontre un petit soucis, le fichier txt et donc le xls sont vide comme si rien ne s'enregistrait ......
0
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
7 sept. 2006 à 12:44
 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
0
xl_squal_lx
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007

7 sept. 2006 à 12:56
(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
0
xl_squal_lx
Messages postés
7
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
19 janvier 2007

7 sept. 2006 à 13:17
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
0