VBA ACCESS récupérer données dans un .txt Résolu

Question

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 !

Yoda · Accepted Answer

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

tomasbruk · Answer

Un petit up, au cas ou !!

tomasbruk · Answer

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 !

VBA ACCESS récupérer données dans un .txt

3 réponses

Discussions similaires

Newsletters