Code VBS pour renomer un fichier excel en fonction de la date et d'un contenu.
Il faut avoir excel d'installer pour ouvir une application excel :-)
- Un messageBox de confirmation de lancement.
- Des répertoires d'arrivé et de départ.
- Un renomage qui dépend du contenu d'une cellule excel (en dur) et de la date, heure minute,...
- Un messageBox de débrefing, temps d'execution, nombres de fichiers copiés, récapitulatif des répertoires.
Source / Exemple :
' VBScript source code
' VBScript source code
'
Set Shell = WScript.CreateObject("WScript.Shell")
a = MsgBox("Etes-vous sûr de vouloir lancer la récupération", vbYesNo)
If (a <> 6) Then WScript.Quit
d1 = Time
Set fso = CreateObject("Scripting.FileSystemObject")
'Source
Set foldeDEPART = fso.GetFolder("R:\05 DSI\03_Applications_Projets\08_Projets\01_Projets_A_Venir\SIAD_Reporting\Gestion_Projet\03_Mise_en_oeuvre\08 Technique\ZZ_draft\test_rapport\test_depart")
'Destination
Set foldeDestination = fso.GetFolder("R:\05 DSI\03_Applications_Projets\08_Projets\01_Projets_A_Venir\SIAD_Reporting\Gestion_Projet\03_Mise_en_oeuvre\08 Technique\ZZ_draft\test_rapport\test_arrivee")
Set filecoll = foldeDEPART.Files
Set appExcel = CreateObject("Excel.Application")
i = 0
For Each Files In filecoll
Set wbexcel = appExcel.Workbooks.Open(Files)
CodeSectionAnalytique = wbexcel.Worksheets(1).Cells(6, 2)
wbexcel.Close
i = i + 1
If CodeSectionAnalytique = " - " Then
Files.Move foldeDestination & "\" & "Probleme_" & Files.Name
Else
newDay = day(now())
newMonth = month(now())
newYear = year(now())
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now())
Files.Move foldeDestination & "\" & "CR_" & CodeSectionAnalytique & "_" & newYear & "_" & newMonth & "_" & newDay & "_" & newHour & "_" & newMinute & "_" & newSecond & ".xls"
End If
Next
Set appExcel = Nothing
Set wbexcel = Nothing
dFin = Time
dInter = dFin - d1
b = MsgBox(" -> " & i & " Fichiers déplacé(s) " & Chr(13) & "de -> " & foldeDestination & Chr(13) & "vers -> " & foldeDEPART & Chr(13) & " -> Temps de traitement : " & minute(dInter) & " min:" & Second(dInter) & " sec." , vbOkOnly, "VBS Script Rename")
If (b <> 6) Then WScript.Quit
WScript.Quit
Conclusion :
J'ai souvent été pris en stop ici.
Alors j'essaye d'aider un peu.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.