Incrementer chaque nouveau fichier importé dans REPERTOIRE

[CAPRI_456]

Bonjour le Forum

J'ai un répertoire central nommé "CENTRE" sur mon lecteur D:\
il réceptionne des fichiers tranmis par plusieurs personnes.
A chaque fois qu'un fichier y est réceptionné je voudrais qu'il soit incrémenté comme suit:
0001_nomdufichier-a.xls
0002_nomdufichier-aae.xls donc peu importe le nom du fichier
etc..

donc simplement un n° croissant à l'arrivée d'un nouveau fichier dans ce répertoire


comment y arriver ?
Dans le cas d'un classeur , on activerait sur un évènement Sub_Change(), Sub_Click()
Mais ici, comment donner cette directive au départ du fichier central , qui est un REPERTOIRE ?

Merci pour votre aide
CAPRI_456

 

[mapomme]

Re : Incrementer chaque nouveau fichier importé dans REPERTOIRE

Bonjour CAPRI_456,

Je ne sais pas faire ce que vous demandez (récupérer un évènement au niveau du système de fichier) mais voici une tentative pour faire la même chose en VBA.

Le fichier joint peut être placé n'importe où y compris dans le dossier des fichiers à incrémenter.

Lancer la macro (cliquez sur le bouton 'Préfixer les nouv...') chaque fois qu'il est nécessaire de préfixer de nouveaux fichiers importés.

Dans le fichier, indiquez en B2 le répertoire de vos fichiers à incrémenter et en B3 la temporisation pour laisser le temps à la commande msdos ou cmd de terminer le listage ( temps qui va dépendre du PC et de la taille du dossier)

Dans le dossier des fichiers à incrémenter ne pas importer de fichier avec pour nom : lister.bat, listage.bat, ou le nom du fichier excel (qui par contre peut-être modifié)

Avant tout essai : sauvegardez votre dossier!

J'espère vous avoir aidé et vous souhaite de joyeuses fêtes de Noël.

Sub Prefixer()
' les fichiers préfixés débutent par NNNN_
Dim FicSuiv As String, Prefix As String, oldPath, newDir
Dim Liste, Nbr, Temp, NumFichier, Tempo

'initialisation
oldPath = CurDir
newDir = Range("B2")
Tempo = Range("B3")
If Right(newDir, 1) <> "\" Then newDir = newDir & "\"

'Création du fichier .bat
ChDir newDir
If Dir(newDir & "lister.bat") <> "" Then Kill newDir & "lister.bat"
If Dir(newDir & "listage.txt") <> "" Then Kill newDir & "listage.txt"
NumFichier = FreeFile
Open newDir & "Lister.bat" For Append As #NumFichier
Print #NumFichier, "Dir " & newDir & "*.* /A-D-H-S-L-R /TC /B /OD >" & newDir & "Listage.txt"
Print #NumFichier, ""
'une p'tite tempo
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)
Close #NumFichier

'recherche les fichiers du dossier via un fichier.bat
Temp = Shell(newDir & "Lister.bat", vbHide)
'temporisation
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + Tempo)

'Chercher le max des fichiers déjà renommés
NumFichier = FreeFile
Open newDir & "Listage.txt" For Input As #NumFichier
Do While Not EOF(NumFichier)
    Line Input #NumFichier, FicSuiv
    If IsNumeric(Mid(FicSuiv, 1, 4)) And Mid(FicSuiv, 5, 1) = "_" Then
        'le fichier est déjà renommé
        If Nbr < CInt(Mid(FicSuiv, 1, 4)) Then Nbr = CInt(Mid(FicSuiv, 1, 4))
    End If
Loop
Close #NumFichier

'Renommer les fichiers
NumFichier = FreeFile
Open newDir & "Listage.txt" For Input As #NumFichier
Do While Not EOF(NumFichier)
    Line Input #NumFichier, FicSuiv
    If LCase(FicSuiv) <> LCase(ThisWorkbook.Name) Then
        If LCase(FicSuiv) <> "lister.bat" Then
            If LCase(FicSuiv) <> "listage.txt" Then
                If Not (IsNumeric(Mid(FicSuiv, 1, 4)) And Mid(FicSuiv, 5, 1) = "_") Then
                    'le fichier n'est pas encore renommé
                    Nbr = Nbr + 1
                    Name newDir & FicSuiv As newDir & Format(Nbr, "0000_") & FicSuiv
                End If
            End If
        End If
    End If
Loop

Close #NumFichier
ChDir oldPath
MsgBox "C'est fini !"
ThisWorkbook.Close SaveChanges:=False
End Sub

 

[CAPRI_456]

Re : Incrementer chaque nouveau fichier importé dans REPERTOIRE

Bonjour et joyeux Noêl à tous les membres de ce Forum,

Merci MaPomme pour cette réponse rapide et ta proposition,
je n'aurai pas le temps de le tester aujourd'hui, convives oblige
mais je reviens à toi, après examen

CAPRI_456

 

[CAPRI_456]

Re : Incrementer chaque nouveau fichier importé dans REPERTOIRE

Bonsoir le Forum, mapomme,

C'est exactement ce qu'il me fallait. Y ai juste apporté quelques modifications par rapport à mes besoins,

Juste un besoin complémentaire :
Comment "prefixer uniquement les fichiers qui se terminent par l'extension "csv" ?
sachant qu'il y aura d'autres extensions dans mon repertoire central

Je suppose que c'est dans cette partie du code que je dois introduire cette limitation :

'Renommer les fichiers
NumFichier = FreeFile
Open newDir & "Listage.txt" For Input As #NumFichier
Do While Not EOF(NumFichier)
Line Input #NumFichier, FicSuiv
If LCase(FicSuiv) <> LCase(ThisWorkbook.Name) Then
If LCase(FicSuiv) <> "*.csv" Then
If LCase(FicSuiv) <> "lister.bat" Then
If LCase(FicSuiv) <> "listage.txt" Then
If Not (IsNumeric(Mid(FicSuiv, 1, 4)) And Mid(FicSuiv, 5, 1) = "_") Then
'le fichier n'est pas encore renommé
Nbr = Nbr + 1
Name newDir & FicSuiv As newDir & Format(Nbr, "0000_") & FicSuiv
End If
End If
End If
End If
Loop

Déjà d'avance pour ton aide précieuse , ma pomme
Merci au Forum et d'excellentes fêtes.

CAPRI_456

 

[mapomme]

Re : Incrementer chaque nouveau fichier importé dans REPERTOIRE

Bonjour,

Une méthode:
Elle consiste à modifier le fichier .bat pour ne lister que les fichiers .csv et par conséquent à ramener moins de fichiers à traiter par la suite de la macro.
remplacer:
Print #NumFichier, "Dir " & newDir & "*.* /A-D-H-S-L-R /TC /B /OD >" & newDir & "Listage.txt"
par
Print #NumFichier, "Dir " & newDir & "*.csv /A-D-H-S-L-R /TC /B /OD >" & newDir & "Listage.txt"

ou bien en utilisant un IF...THEN comme vous le suggérez:

IF lcase(right(trim(FicSuiv),4))=".csv" THEN

 

[CAPRI_456]

Re : Incrementer chaque nouveau fichier importé dans REPERTOIRE

Bonjour le Forum, ma pomme,

remplacer:
Print #NumFichier, "Dir " & newDir & "*.* /A-D-H-S-L-R /TC /B /OD >" & newDir & "Listage.txt"
par
Print #NumFichier, "Dir " & newDir & "*.csv /A-D-H-S-L-R /TC /B /OD >" & newDir & "Listage.txt"

Ok , c'est parfait, je viens d'adapter le code comme proposé dans la 1ère solution :
"*.CSV" dans la ligne print étant plus court et plus "parlant" .

Merci pour ce suivi , mapomme.

Par contre, en testant plus loin cette procédure de numérotation j'ai maintenant l'erreur suivante dans cette partie du code
(bug : erreur d'exécution 53 Fichier introuvable) au niveau de cette ligne

Open newDir & "Listage.txt" For Input As #NumFichier

et lorsque je continue alt F11 / "exécuter la macro" cela continue bien la macro donc exécute la numérotation correctement
mais à chaque tour de boucle, la même erreur pour le fichier suivant

D'où peut venir ce blocage momentanné ??

Meric d'avance
Bon appétit à tous les membres.

CAPRI_456

 

[mapomme]

Re : Incrementer chaque nouveau fichier importé dans REPERTOIRE

Bonsoir,

Je n'arrive pas à reproduire l'erreur. Au moment de la 1ière erreur 53, pouvez-vous vérifiez que le fichier listage.txt est bien présent dans votre répertoire ?

 

[CAPRI_456]

Re : Incrementer chaque nouveau fichier importé dans REPERTOIRE

Bonsoir le Forum, mapomme,

vérifiez que le fichier listage.txt est bien présent dans votre répertoire ?

Oui, j'ai bien vérifié ledit fichier listage.txt, il est bien dans le repertoire de destination et le contenu de ce .txt reflète bien le contenu du repertoire.

Ce qui est étonnant c'est que en continuant la manoeuvre ("exécution, continuer du vba), il numérote mes fichiers un à un correctement, donc c'est une bonne macro, je ne comprend seulement pas pourquoi il met la mention "fichier introuvable" et surtout comment solutionner cet aspect là.

Je continue à chercher d'où pourrait venir ce problème !
oups ouups;;;; je viens de trouver la solution... me semble t'il

'If Dir(newDir & "lister.bat") <> "" Then Kill newDir & "lister.bat"
'If Dir(newDir & "listage.txt") <> "" Then Kill newDir & "listage.txt"

en neutralisant les instructions KILL en début de code pour le .bat et le .txt, cela devient impeccable.
J'espère que cela stabilisera la suite.

Mapomme, le Forum,
Merci pour cette aide précieuse.

CAPRI_456

 

[mapomme]

Re : Incrementer chaque nouveau fichier importé dans REPERTOIRE

Bonsoir,

Essayez :
1) de remettre en fonctionnement les instructions 'Kill' et augmenter la Tempo.
ou bien
2) une nouvelle version du fichier sans la tempo.

 

[CAPRI_456]

Re : Incrementer chaque nouveau fichier importé dans REPERTOIRE

Bonsoir le Forum, mapomme,

J'examine cela et reviens à toi.
Excellente année 2012

Merci
CAPRI_456