Code vbs pour renomer un fichier excel en fonction de la date et d'un contenu.

Commenter

Contenu du snippet

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.

A voir également

Du même auteur (yannlevrai)