Bonsoir à tous.

Programmeur amateur depuis quelques années, je suis en train de découvrir le VBS. Je viens de développer un petit soft pour mon boulot et j'aimerais avoir votre avis.

Voici le problème :

- plusieurs utilisateurs enregistrent des messages (reçus avec Mozilla Thunderbird) sur un serveur via un lecteur réseau.
- ces messages sont classés dans des dossiers et sous-dossiers en fonction de l'année, du mois, etc...
- le niveau de l'arborescence n'est pas fixe, ils peuvent ajouter des sous-dossiers de sous-dossier à leur convenance.
- il arrive qu'un message ait été transféré plusieurs fois avant de leur parvenir.
- il arrive aussi qu'ils reçoivent plusieurs fois le même message avec des noms différents car il est passé par divers expéditeurs.

on se retrouve donc avec quelque chose comme ça :

MSG_RECUS
____2007
________janvier
____________mail_01
____________mail_02
____________[Fwd mail_03]
________février
____________[Fwd [Fwd [Fwd [Fwd mail_04]]]]
________septembre
____________mail_86
____________[Fwd mail_86] .......... (cet email a été modifié avant d'etre transféré)
____2008
________juillet
____________mail_145
____________[Fwd [Fwd mail_213]]
____________[Fwd [Fwd [Fwd mail_213]]]
____________mail_578

Je me retrouve donc avec plusieurs problèmes :
- quand un email est enregistré, l'objet de l'email est utilisé pour créer le nom du fichier ; étant donné que les expéditeurs mettent des objets explicites assez long, il arrive que le nom de fichier dépasse les 254 caractères ; ce qui implique des erreurs lors de la sauvegarde du serveur.
- un même email peut donc être enregistré plusieurs fois (mais avec un nom différent).
- un même email peut avoir été reçu plusieurs fois et comporter des modifications ; ce qui revient à avoir 2 emails différents.

Je cherche donc à "trier" ces archives pour obtenir ça :

MSG_RECUS
____2007
________janvier
____________mail_01
____________mail_02
____________mail_03
________février
____________mail_04
________septembre
____________mail_86
____________mail_86_date_heure .......... (on renomme ce fichier pour montrer qu'il est différent du précédent)
____2008
________juillet
____________mail_145
____________mail_213
____________mail_578

Je me suis inspiré de morceaux de codes trouvés sur ce forum et voici ce que j'ai élaboré :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
Option Explicit
 
Dim FSO, Fichier, Fichier_existe, Dossier, Sous_dossier, Ancien_nom, Nouveau_nom
Dim Ctr_renomme, Ctr_supprime
Dim Attributs_ancien, Attributs_nouveau, longueur_nom, Extension
Dim jj, mm, aa, hh, mn
 
Set FSO = CreateObject("Scripting.FileSystemObject")
Ctr_renomme = 0
Ctr_supprime = 0
 
' On fait appel à la fonction pour parcourir les sous-dossiers à partir du chemin courant
Parcourir FSO.GetFolder(".")
' On affiche le nombre de fichiers traités
Wscript.Echo Ctr_renomme & " fichiers renommés" & vbcrlf & Ctr_supprime & " fichiers supprimés"
 
 
Sub Parcourir(Nom_Dossier)
 
	' On traite chaque sous-dossier à partir du dossier courant
	For Each Sous_dossier in Nom_Dossier.SubFolders
 
		'  On traite chaque fichier du sous-dossier
		For each Fichier in  FSO.GetFolder(Sous_dossier.Path).Files
 
			' On calcule la longueur du nom de fichier sans l'extension
			longueur_nom = len(Fichier.Name) - 4
			' On récupere l'ancien nom du fichier sans l'extension
			Ancien_nom = Mid(Fichier.Name,1,longueur_nom)
			' On récupere l'extension du fichier
			Extension = "." & Mid(Fichier.Name,longueur_nom + 2,3)
 
			' On enlève les caractères inutiles pour préparer le nouveau nom du fichier
			Nouveau_nom = Replace(Ancien_nom,"Fwd ","")
			Nouveau_nom = Replace(Nouveau_nom,"Fwd","")
			Nouveau_nom = Replace(Nouveau_nom,"[ ","")
			Nouveau_nom = Replace(Nouveau_nom,"[","")
			Nouveau_nom = Replace(Nouveau_nom,"]","")
			Nouveau_nom = Replace(Nouveau_nom,"  ","")
			Nouveau_nom = Replace(Nouveau_nom,"..",".")
 
			' On vérifie si le nom a changé
			If Ancien_nom <> Nouveau_nom Then
 
				' On récupère le nom du sous-dossier en cours
				Set Dossier = fso.GetFolder(Sous_dossier.Path)
 
				' On vérifie si un fichier existe déjà avec le nouveau nom de fichier
				Fichier_existe = FSO.FileExists(Dossier & "\" & Nouveau_nom & Extension)
 
				' Si un fichier existe déjà avec le nouveau nom de fichier
				If Fichier_existe then
 
					' On récupère la date de dernière modification du fichier avec l'ancien nom
					Set Attributs_ancien = FSO.GetFile(Dossier & "\" & Ancien_nom & Extension)
 
					' On récupère la date de dernière modification du fichier avec le nouveau nom
					Set Attributs_nouveau = FSO.GetFile(Dossier & "\" & Nouveau_nom & Extension)
 
					' On vérifie si le fichier a été modifié
					If Attributs_ancien <> Attributs_nouveau Then
 
						' On récupère la date et l'heure de dernière modification de l'ancien fichier
						jj =  Mid(Attributs_ancien.DateLastModified, 1,2)
						mm =  Mid(Attributs_ancien.DateLastModified, 4,2)
						aa =  Mid(Attributs_ancien.DateLastModified, 7,4)
						hh =  Mid(Attributs_ancien.DateLastModified, 12,2)
						mn =  Mid(Attributs_ancien.DateLastModified, 15,2)
 
						' On vérifie si un fichier existe déjà avec le nouveau nom de fichier concaténé
						Fichier_existe = FSO.FileExists(Dossier & "\" & Nouveau_nom & "_" & aa & mm & jj & hh & mn & Extension)
 
						' Si un fichier existe déjà avec le nouveau nom de fichier
						If Fichier_existe then
 
							' On supprime le fichier avec l'ancien nom
							FSO.DeleteFile (Dossier & "\" & Ancien_nom & Extension)
 
							' On incrémente le compteur de fichiers supprimés
							Ctr_supprime = Ctr_supprime + 1
 
						' Si aucun fichier existe avec le nouveau nom de fichier concaténé
						Else
 
							' On renomme l'ancien fichier avec le nouveau nom concaténé avec sa date de dernière modification
							FSO.MoveFile (Dossier & "\" & Ancien_nom & Extension) , (Dossier & "\" & Nouveau_nom & "_" & aa & mm & jj & hh & mn & Extension)
 
							' On incrémente le compteur de fichiers renommés
							Ctr_renomme = Ctr_renomme + 1
 
						End If
 
					' Mais s'il n'a pas été modifié
					Else
 
						' On supprime le fichier avec l'ancien nom
						FSO.DeleteFile (Dossier & "\" & Ancien_nom & Extension)
 
						' On incrémente le compteur de fichiers supprimés
						Ctr_supprime = Ctr_supprime + 1
 
					End If
 
				' Si aucun fichier existe avec le nouveau nom de fichier
				Else
 
					' On renomme le fichier avec le nouveau nom
					FSO.MoveFile (Dossier & "\" & Ancien_nom & Extension) , (Dossier & "\" & Nouveau_nom & Extension)
 
					' On incrémente le compteur de fichiers renommés
					Ctr_renomme = Ctr_renomme + 1
 
				End If
 
			End If
 
		Next
 
		' On refait appel à la fonction pour parcourir les sous-dossiers à partir du chemin courant <==> effet recursif.....
		Parcourir Sous_dossier
 
	Next
 
End Sub
Si vous avez des idées pour optimiser ou des critiques à émettre, je suis toute ouïe.

Merci d'avance !