Macro concaténation de fichier

M6sou Messages postés 70 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention - 12 juin 2014 à 17:00

Salut à tous et à toutes,
Voilà, actuellement je travail sur projet de base de données. Néanmoins, avant de l'attaquer, je devais trier et concaténer des fichiers logs. Sur les conseils d'une personnes, après avoir réaliser ma macro de tir des fichiers, je les ai enregistré en .csv. J'ai donc désormais des fichiers de cette forme là Tss_dataJJMMAAHHMM.log.csv :
Tss_data0102130800.log.csv
Tss_data0102130856.log.csv
Tss_data0506131625.log.csv

J'en ai environ 3000 sur 3 ans, et il peut y avoir plusieurs fichiers par jours. D'où mon problème. Je dois maintenant trouver une solution afin de concaténer ces fichiers .csv .
J'aimerais donc une macro me permettant de dire :
-Prend les fichiers ayant les 14 premiers caractères (Tss_dataJJMMAA) identiques;
-Concaténe les;
-Enregistre le au même nom;
-Et réitère l'opération jusqu'au dernier fichier.

Je ne viens pas les mains vident of course, j'ai déjà réussis la concaténation de tout les fichiers d'un dosiers ainsi que son enregistrement. Il ne manque que la partie "par nom de fichier" que je galère pas mal .

Option Explicit

Sub importDonnees()
    Dim principal As ThisWorkbook
    Dim repertoire As String, Fichier$
    Application.ScreenUpdating = False
    Set principal = ThisWorkbook
    repertoire = "C:\Documents and Settings\9403095F\Bureau\Test_Macro\"
    Fichier = Dir(repertoire & "*.csv")
    
    If "Date1" Like "Date2" Then
    
    Do While Fichier <> ""
        Workbooks.Open (repertoire & Fichier)
        ActiveSheet.UsedRange.Copy Destination:=principal.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1)
        ActiveWorkbook.Close
        Fichier = Dir
    Loop
        
    ChDir "C:\Documents and Settings\9403095F\Bureau\Test_Macro\Nouveau\"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\9403095F\Bureau\Test_Macro\Nouveau\Finale.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=True
    End If

End Sub

Merci d'avance pour vos réponse,
Bonne journée !!

Afficher la suite

A voir également:

Macro concaténation de fichier
Fichier bin - Guide
Fichier epub - Guide
Fichier rar - Guide
Comment réduire la taille d'un fichier - Guide
Fichier .dat - Guide

4 réponses

Réponse 1 / 4

M6sou Messages postés 70 Date d'inscription Statut Membre Dernière intervention

Le code précédent est incomplet.
Petite mise à jour. Après avoir fait pas mal de recherches, j'ai opté pour une solution.
Mon idée est la suivante:
Etant donnée que tout les noms de fichiers ont la même structure, et que ce qui m'intéresse est la date, j'ai décidé de prendre le milieu du nom de fichier et de les comparer entre eux.
Pour ce faire, j'ai écris le code suivant :

Option Explicit

Sub importDonnees()
   Dim principal As ThisWorkbook    
   Dim repertoire As String
    Dim NomFichierActif As String
    Dim DateActiveP As String
    Dim DateActive As String
    Dim Init As Boolean
    
    Application.ScreenUpdating = False
    Set principal = ThisWorkbook
    repertoire = "C:\Documents and Settings\...\Bureau\Test_Macro\"
    NomFichierActif = Dir(repertoire & "*.csv")
    Init = True
    Do While NomFichierActif <> ""
        DateActive = Mid(NomFichierActif, 9, 6) ' Prendre la date 1 sur le nom d'un fichier                 
            If DateActiveP = DateActive Then ' Comparer date 1 et date 2   
 Workbooks.Open (repertoire & NomFichierActif) ' copie               
 ActiveSheet.UsedRange.Copy Destination:=principal.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1) ' copie                ActiveWorkbook.Close True
                NomFichierActif = Dir
                DateActiveP = DateActive ' mettre la date 1 dans la date 2                Init = False
                ChDir "C:\Documents and Settings\9403095F\Bureau\Test_Macro\Nouveau\"
            
        End If
    Loop
End Sub

Néanmoins, le programme ne fonctionne pas (sinon je ne serais pas là je pense :D). Il semblerait qu'il bloque au lignes suivante (en gras dans le programme) :
Workbooks.Open (repertoire & NomFichierActif) ' copie ActiveSheet.UsedRange.Copy Destination:=principal.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1) ' copie

Merci pour vos réponses et aide,
Bonne journée !

Réponse 2 / 4

M6sou Messages postés 70 Date d'inscription Statut Membre Dernière intervention

Personne ?

Réponse 3 / 4

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

repertoire = "C:\Documents and Settings\...\Bureau\Test_Macro\"

le chemin doit etre complet

M6sou Messages postés 70 Date d'inscription Statut Membre Dernière intervention

Dans mon programme le chemin est complet là j'ai juste mis des "..." par fainéantise de tout mettre :)

Réponse 4 / 4

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

une facon differente de faire:

principe:
deux objets Dictionary , Dico1 pour mise en memoire Date et les noms de fichiers meme date, Dico2 date et nombre de fichiers meme date (je pense qu'il et possible de faire avec un seul avec la valeur de clef)

commande Dos (ici pour deux fichiers):
copy chemin & Fichier1 + chemin & fichier2 chemin & fichierFinal

pensez a mettre votre ou vos repertoires

Option Explicit
'--------------------------- API attente en ms ---------------------------------------------------------
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'-------------------------------------------------------------------------------------------------------------

Sub concat_fichier()
    Dim repertoire As String
    Dim NomFichierActif As String
    Dim FDate As String
    Dim TFichier, point As Integer, FFichier, retval
    Dim Dico1, Dico2, curKey, sConcat
    
    Application.ScreenUpdating = False
    Set Dico1 = CreateObject("Scripting.Dictionary")
    Set Dico2 = CreateObject("Scripting.Dictionary")
    'repertoire a adapter
    repertoire = "D:\_ACSV\"
    NomFichierActif = Dir(repertoire & "*.csv")
    Do While NomFichierActif <> ""
        If Left(NomFichierActif, 4) = "Tss_" Then
            'liste fichiers, date
            FDate = Mid(NomFichierActif, 9, 6)
            'liste Date
            If Not Dico2.Exists(FDate) Then
                Dico2.Add FDate, 1
                Dico1.Add FDate, NomFichierActif
            Else
                'compteur NbFichier meme date
                Dico2.Item(FDate) = Dico2.Item(FDate) + 1
                'rang cle en cours
                point = Application.Match(FDate, Dico1.keys, 0)
                'ajout fichiers meme date
                Dico1.Item(FDate) = Dico1.Item(FDate) & "-" & NomFichierActif
            End If
        End If
        NomFichierActif = Dir
    Loop
    'boucle sur Dico2 pour concatenation fichiers mem date
    For Each curKey In Dico2
        If Dico2.Item(curKey) > 1 Then      'test si plusieurs fichiers meme date
            'mise en tableau des noms de fichier
            TFichier = Split(Dico1.Item(curKey), "-")
            'nom de fichier final
            FFichier = Left(TFichier(0), 14) & ".CSV"
            'Chaine de commande DOS pour concatenation fichier
            sConcat = "cmd /c Copy " & repertoire
            'boucle fichier -1
            point = UBound(TFichier)
            For point = 0 To point - 1
                'ajout fichier
                sConcat = sConcat & TFichier(point) & "+" & repertoire
            Next
            'aout dernier fichier
            sConcat = sConcat & TFichier(point)
            'ajout nom de fichier final
            sConcat = sConcat & " " & repertoire & FFichier
            'commande shell
            retval = Shell(sConcat, vbMinimizedNoFocus)
            'attente: ici 200ms, peut etre remplace par ctrl process shell (a voir)
            Sleep 200
        End If
    Next curKey
    Application.ScreenUpdating = True
End Sub

Question: pourquoi passer par une conversion CSV ???????
Les fichiers de log sont des fichiers texte

M6sou Messages postés 70 Date d'inscription Statut Membre Dernière intervention

Salut f894009, merci pour ta réponse et désolez pour le temps qu'aura mise la mienne.
Pour l'histoire de la conversion, elle n'est pas obligatoire pour finir.

Merci pour le programme, j'ai exécuté le programme, en y remplaçant mon répertoire, mais je ne comprends pas une chose :
Où s'enregistre les fichiers finaux ? Car quand je lance le code, je vois bien la fenêtre de cmd s'ouvrir et se fermer rapidement, et travailler mais je ne trouve pas les fichiers de sortie...

Saurez tu où ils se trouvent ?

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

Je n'avais qu'un seul repertoire:

 repertoire = "D:\_ACSV\"

utilise ici:

NomFichierActif = Dir(repertoire & "*.csv")

et

ici:

sConcat = sConcat & " " & repertoire & FFichier

a vous de voir ce que vous avez mis comme repertoires

M6sou Messages postés 70 Date d'inscription Statut Membre Dernière intervention

Oui pour ça je suis d'accord, j'ai mis mon repertoire, le programme tourne bien, mais je ne trouve pas mes fichiers de sorties (fichiers concaténés) ... Ils ne s'enregistrent pas dans le même répertoire

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

Mettez votre code a dispo svp

M6sou Messages postés 70 Date d'inscription Statut Membre Dernière intervention

Option Explicit
'--------------------------- API attente en ms ---------------------------------------------------------
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'-------------------------------------------------------------------------------------------------------------
Sub concat_fichier()
Dim repertoire As String
Dim NomFichierActif As String
Dim FDate As String
Dim TFichier, point As Integer, FFichier, retval
Dim Dico1, Dico2, curKey, sConcat
Application.ScreenUpdating = False
Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")    'repertoire a adapter
NomFichierActif = Dir(repertoire & "*.txt")
repertoire = "C:\Documents and Settings\9403095F\Bureau\Test\"
Do While NomFichierActif <> ""
If Left(NomFichierActif, 4) = "Tss_" Then            'liste fichiers, date
FDate = Mid(NomFichierActif, 9, 6)            'liste Date
If Not Dico2.Exists(FDate) Then
Dico2.Add FDate, 1
Dico1.Add FDate, NomFichierActif
Else                'compteur NbFichier meme date
Dico2.Item(FDate) = Dico2.Item(FDate) + 1                'rang cle en cours
point = Application.Match(FDate, Dico1.keys, 0)                'ajout fichiers meme date
Dico1.Item(FDate) = Dico1.Item(FDate) & "-" & NomFichierActif
End If
End If
NomFichierActif = Dir
Loop    'boucle sur Dico2 pour concatenation fichiers meme date
For Each curKey In Dico2
If Dico2.Item(curKey) > 1 Then      'test si plusieurs fichiers meme date
'mise en tableau des noms de fichier
TFichier = Split(Dico1.Item(curKey), "-")
'nom de fichier final
FFichier = Left(TFichier(0), 14) & "*.txt"            'Chaine de commande DOS pour concatenation fichier
sConcat = "cmd /c Copy " & repertoire            'boucle fichier -1
point = UBound(TFichier)
For point = 0 To point - 1                'ajout fichier
sConcat = sConcat & TFichier(point) & "+" & repertoire
Next            'aout dernier fichier
sConcat = sConcat & TFichier(point)            'ajout nom de fichier final
sConcat = sConcat & " " & repertoire & FFichier            'commande shell
retval = Shell(sConcat, vbMinimizedNoFocus)            'attente: ici 200ms, peut etre remplace par ctrl process shell (a voir)
Sleep 200
End If
Next curKey
Application.ScreenUpdating = True
End Sub

Votre réponse