VBA ACCESS récupérer données dans un .txt [Résolu/Fermé]

Signaler
-
 tomasbruk -
Bonjour à tous,
Afin de réaliser une mise à jour je recois un dossier composé d'une centaine de petits fichiers .txt. Chaques fichiers faisant références à un groupe (nom de fichier = nom d'un groupe).
De plus chacun de ses fichiers .txt contient les utlisateurs concernés (1 ligne du fichier .txt = 1 utilisateur).
Donc j'arrive à recuperer les noms de chaque fichier .txt afin de les mettre dans une colonne au sein d'un fichier excel ou csv.
code:

Set objFSO = CreateObject("Scripting.FileSystemObject")
Repertoire = "C:\Documents and Settings\chemin"

'Accède au dossier
If objFSO.FolderExists(Repertoire) Then
    Set oFld = objFSO.GetFolder(Repertoire)
    MsgBox "Dossier trouvé"
Else
    MsgBox "Ce dossier n'existe pas"
End If

' extraction de la liste des groupes - utlisateurs
  Const ctePourLecture = 1
  Const ctePourEcrire = 2
  Const ctePourAjouter = 8

  On Error Resume Next
  NomFichierTxt = "Resultat.csv"
  
  Set objDossier = objFSO.GetFolder(Repertoire)
  Set objResultat = objFSO.CreateTextFile((Repertoire & "\" & NomFichierTxt), ctePourEcrire)

  If (objDossier.Files.Count > 0) Then
     For Each objFichier In objDossier.Files
        If (InStr(1, objFichier.Name, ".txt", 1) > 0) Then
            objResultat.WriteLine objFichier.Name
        End If
     Next
   End If
  objResultat.Close
  Set objResultat = Nothing
  Set objDossier = Nothing
  Set objFSO = Nothing


Mais je souhaiterais également récuperer chaque lignes contenus dans ses fichiers.
J'arrive à récupérer les lignes d'un fichier, mais je voudrais le faire pour tous les fichiers du dossier (sachant que les noms des fichiers peuvent etre différent d'une MAJ à l'autre).
Voici comment je procede pour 1 fichier:

Const ctePourLecture = 1
Const ctePourEcrire = 2
Const ctePourAjouter = 8

Dim intFic As Integer
Dim strLigne As String
Dim objFSO, objResultat
Dim Repertoire, NomFichierTxt

Set objFSO = CreateObject("Scripting.FileSystemObject")

NomFichierTxt = "Resultat2.csv"
Repertoire = "C:\Documents and Settings\chemin"
Repertoire2 = "C:\Documents and Settings\chemin du fichier"
intFic = FreeFile

Open (Repertoire2) For Input As intFic
Set objResultat = objFSO.CreateTextFile((Repertoire & "\" & NomFichierTxt), ctePourEcrire)
    
While Not EOF(intFic)
    Line Input #intFic, strLigne
    MsgBox strLigne
    objResultat.WriteLine strLigne
    
    
Wend
Close intFic



Un petit coup main me ferais du bien, car je n'y arrive pas.
Merci !

3 réponses

Bonjour,

Si j'ai bien compris ton problème, cette procédure devrait t'aider

Sub Collecter_Donnees()

Dim strLigne As String
Dim Repertoire, NomFichierTxt_Out, NomFichierTxt_Inp, NomFichierTxt_Dat

Repertoire = "C:\Documents and Settings\chemin\" 'Repertoire de travail
NomFichierTxt_Out = Repertoire & "Resultat2.csv" 'Fichier à créer
NomFichierTxt_Inp = Repertoire & "Resultat.csv"  'Fichier avec les Noms des Fichiers txt

Close 'Fermer tous les fichiers
Open NomFichierTxt_Out For Output As #1 'création du fichier Resultat2.csv
  
Open NomFichierTxt_Inp For Input As #2  'lecture du fichier Resultat.csv
	
    While Not EOF(2)
	
	   Line Input #2, strLigne 'Lecture de la ligne
	   NomFichierTxt_Dat = Repertoire & strLigne 'Nom du fichier de données
	   
	    Open NomFichierTxt_Dat For Input As #3  'Lecture du fichier de données
	    While Not EOF(3)
			Line Input #3, strLigne 'Lecture ligne de donnée
			Print #1, strLigne 'Transfert dans le fichier Resultat2.csv
		Wend
		Close #3 'Fermer Fichier de données
		
	Wend

Close 'Fermer tous les fichiers

End Sub
2
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 58198 internautes nous ont dit merci ce mois-ci

Un petit up, au cas ou !!
Bonjour Yoda,

Je pense que tu as compris ce que je voulais mais malheureusement, ton code ne créé pas le fichier Resultat.csv, j' ai une erreur 53 - fichier introuvable sur la ligne :
Open NomFichierTxt_Inp For Input As #2  'lecture du fichier Resultat.csv

S'en ca si je créé moi même le fichier resultat.csv je n'ai plus d'erreur mais mes 2 fichiers resultat sont vides !
La colonne des groupes est en forme de ligne a1 b1 c1... etc.
Donc en a1 j'ai le groupe et en a2 a3 a4...etc il y a les users, idem pour b1 et les autres colonne.
Certaines colonnes, on un groupe mais pas de users.
Bon week
Bonjour,
Si les noms de groupes correspondent aux noms des fichiers txt, on peut facilement créer les deux fichiers résutats en même temps.
Sinon, il faudra faire une macro Excel...
;)
Bonjour Yoda,
Les noms de groupes correspondent effectivement aux noms des fichiers txt.
C'est certain que faire les 2 fichiers résultats dans la meme instruction serait l'idéal.
Merci encore...
Bonjour,
Je t'ai modifié la macro pour la création de deux fichiers resultat2.csv et resutat3.csv
Il suffira de modifier la ligne avec tes données personnelles
Repertoire = "C:\Documents and Settings\chemin\" 'Repertoire de travail

Sub Collecter_Donnees()

Dim Table_ID(1000, 500) As String
Dim nl As Integer, nc As Integer, MaxL As Integer, MaxC As Integer
Dim strStart As Integer, strStop As Integer
Dim Groupe As String
Dim strLigne As String
Dim Repertoire, NomFichierTxt_Out, NomFichierTxt_Inp, NomFichierTxt_Dat

Repertoire = "C:\Documents and Settings\chemin\" 'Repertoire de travail
'NomFichierTxt_Out = Repertoire & "Resultat2.csv" 'Fichier à créer
NomFichierTxt_Inp = Repertoire & "Resultat.csv"  'Fichier avec les Noms des Fichiers txt

Close 'Fermer tous les fichiers
'Open NomFichierTxt_Out For Output As #1 'création du fichier Resultat2.csv
  
nc = 0: nl = 1: MaxL = 0: MaxC = 0
Open NomFichierTxt_Inp For Input As #2  'lecture du fichier Resultat.csv
    
    While Not EOF(2)
    
       Line Input #2, strLigne 'Lecture de la ligne
       Groupe = Left(strLigne, Len(strLigne) - 4) 'lecture du Nom du Groupe
       Table_ID(0, nc) = Groupe 'Nom du groupe en tete de colonne
       
       NomFichierTxt_Dat = Repertoire & strLigne 'Nom du fichier de données
       
        Open NomFichierTxt_Dat For Input As #3  'Lecture du fichier de données
        While Not EOF(3)
            Line Input #3, strLigne 'Lecture ligne de donnée
            If InStr(1, strLigne, "CN=") > 0 Then
               strStart = InStr(1, strLigne, "CN=") + 3
               strStop = InStr(strStart, strLigne, ",")
               strLigne = Mid(strLigne, strStart, strStop - strStart)
               Table_ID(nl, nc) = strLigne
               nl = nl + 1
           End If
            If nl > MaxL Then MaxL = nl
        Wend
        Close #3 'Fermer Fichier de données
        nl = 1
        nc = nc + 1
    Wend
MaxC = nc
Close 'Fermer tous les fichiers

NomFichierTxt_Out = Repertoire & "Resultat2.csv" 'Fichier à créer
Open NomFichierTxt_Out For Output As #1 'création du fichier Resultat2.csv
'nc = 0: nl = 0
For nl = 0 To MaxL - 1
    For nc = 0 To MaxC - 1
        Write #1, Table_ID(nl, nc),
    Next
    Print #1, ""
Next
Close
MsgBox NomFichierTxt_Out & " créé avec succes."

NomFichierTxt_Out = Repertoire & "Resultat3.csv" 'Fichier à créer
Open NomFichierTxt_Out For Output As #1 'création du fichier Resultat3.csv
'nc = 0: nl = 0
For nc = 0 To MaxC - 1
    For nl = 1 To MaxL - 1
        If Table_ID(nl, nc) = "" Then Exit For
        Write #1, Table_ID(0, nc), Table_ID(nl, nc)
    Next
Next
Close
MsgBox NomFichierTxt_Out & "créé avec succes"

End Sub
C'est impeccable Yoda, tout fonctionne comme sur des roulettes.
Je clos donc le sujet et, encore un grand merci pour ton aide Yoda !