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
| Dim fso,path,fc,newFile
Dim typeExt,longName,sepDate
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
' Récupération du chemin absolu d'exécution du script
Set path = fso.GetAbsolutePathName(".")
Set fc = path.Files
typeExt="xls"
longName=23
sepDate="_"
' Pour chaque fichier contenu dans le répertoire courant
For Each f1 in fc
' On traite seulement les fichiers Excel de longueur 23 (type Jour_DRIRE_L212_02_2007.XLS)
If Ucase(Split(f1.name, ".")(1)) = Ucase(typeExt) and Len(Split(f1.name, ".")(0)) = longName Then
If (Len(Split(Left(Split(f1.name, ".")(0),13),sepDate)(0)) = 2 and Len(Split(Left(Split(f1.name, ".")(1),13),sepDate)(0)) = 2 and Len(Split(Left(Split(f1.name, ".")(2),13),sepDate)(0)) = 4) then
' Nouveau nom de type Jour_DRIRE_L2_2007_02_12.XLS
Set newFile = path.Name & "\" & Split(f1.name, ".")(0) & sepDate & Split(Left(Split(f1.name, ".")(0),13),sepDate)(2) & sepDate & Split(Left(Split(f1.name, ".")(0),13),sepDate)(1) & sepDate & Split(Left(Split(f1.name, ".")(0),13),sepDate)(0) & "." & typeExt
If (fso.FileExists(newFile) = true) then
Msgbox "Le fichier " & newFile & " existe déjà.",vbinformation,"Renommage fichiers export"
else
fso.MoveFile path.Name & "\" & f1.name, newFile
end if
end if
end if
Next
Msgbox "Le renommage des fichiers est terminé.", vbinformation, "Renommage fichiers export" |
