Macro concaténation de fichier Fermé

Question

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 ExplicitSub 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 IfEnd SubMerci d'avance pour vos réponse,
Bonne journée !!

M6sou · Answer

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 ExplicitSub 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    LoopEnd 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 !

M6sou · Answer

Personne ?

f894009 · Answer

Bonjour,


repertoire = "C:\Documents and Settings\...\Bureau\Test_Macro\"

le chemin doit etre complet

f894009 · Answer

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 = TrueEnd Sub

Question: pourquoi passer par une conversion CSV ???????
Les fichiers de log sont des fichiers texte