aide pour mon code VBA

[Vinvinsylvain]

Bonjour a tous
Voilà le code si dessou me permet de créer un dosier 'Archive' et de créer des archives excel dedans, mon problème, une fois qu'il a fini d'archiver des classeur excel je voudrais qu'il renomme le Dossier archive par ARCHIVE + la date du jour(exp. Archive 07-05-2005), comment je dois faire?
Je vous remercie d'avance pour vos réponse

Dim fso 'As Scripting.FileSystemObject
Private Sub CommandButton1_Click()
Dim fd 'As Scripting.Folder
Dim s 'As String
Dim sFolderName
Dim sNewName 'As String
Dim sTemp 'As String
Dim MonNom As String
Dim MyDate As Date

MyDate = Date
strDate = Format(Date, 'dd-mm-yy')

sFolderName = 'C:\\Documents and Settings\\Décorateur\\Bureau\\NewDosier'
sNewName = 'Archive'
Set fso = CreateObject('Scripting.FileSystemObject')

If Not fso.FolderExists(sFolderName) Then

Set fd = fso.CreateFolder(sFolderName)
MsgBox 'Le dossier' & sFolderName & ' a été créé'
Else
MsgBox 'Le dossier' & sFolderName & ' existe déjà!'
End If


If fso.FolderExists(sFolderName) Then
Set fd = fso.GetFolder(sFolderName)
sTemp = fd.Drive & '\\' & sNewName
If fso.FolderExists(sTemp) Then
MsgBox 'Ce nom de dossier existe déjà'
Else

fd.Name = sNewName

MsgBox 'Le dossier' & sFolderName & 'a été renommé!'
End If
Else
MsgBox 'dossier non trouvé!'
End If
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005'

Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\bon consommation.xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau\\Archive'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Archive\\bon consommation.xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate

Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Main Courante.xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau\\Archive'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Archive\\Main Courante.xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate

Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Listing Visiteur et Personnel.xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau\\Archive'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Archive\\Listing Visiteur et Personnel.xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate


Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Listing Maquillage.xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau\\Archive'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Archive\\Listing Maquillage.xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate


Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Contrô.perma..xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau\\Archive'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Archive\\Contrô.perma..xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate

Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Clefs\\Clefs.xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau\\Archive'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Archive\\Clefs.xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate
Set objFSO = CreateObject('Scripting.FileSystemObject')
objFSO.DeleteFile ('C:\\Documents and Settings\\Décorateur\\Bureau\\Clefs\\Clefs.xls')

Set objFSO = CreateObject('Scripting.FileSystemObject')
objFSO.DeleteFile ('C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\bon consommation.xls')

Set objFSO = CreateObject('Scripting.FileSystemObject')
objFSO.DeleteFile ('C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Main Courante.xls')

Set objFSO = CreateObject('Scripting.FileSystemObject')
objFSO.DeleteFile ('C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Listing Visiteur et Personnel.xls')

Set objFSO = CreateObject('Scripting.FileSystemObject')
objFSO.DeleteFile ('C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Listing Maquillage.xls')

Set objFSO = CreateObject('Scripting.FileSystemObject')
objFSO.DeleteFile ('C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Contrô.perma..xls')

'''''''''''''''''''''''''''''''''''''' deuxième procédure''''''''''''''''''''''''''''''''''''''''''''

ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005 Vierge'

Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005 Vierge\\bon consommation.xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\bon consommation.xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate

Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005 Vierge\\Main Courante.xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Main Courante.xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate

Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005 Vierge\\Listing Visiteur et Personnel.xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Listing Visiteur et Personnel.xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate


Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005 Vierge\\Listing Maquillage.xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Listing Maquillage.xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate


Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005 Vierge\\Contrô.perma..xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005\\Contrô.perma..xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate

Workbooks.Open Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Sécurité2005 Vierge\\Clefs.xls'
ChDir 'C:\\Documents and Settings\\Décorateur\\Bureau'
ActiveWorkbook.SaveAs Filename:='C:\\Documents and Settings\\Décorateur\\Bureau\\Clefs\\Clefs.xls'
ActiveWorkbook.Close
' Windows('Archivage').Activate

Application.CommandBars('Stop Recording').Visible = True
Application.CommandBars('Standard').Visible = True
Application.CommandBars('Formatting').Visible = True
Application.CommandBars('Drawing').Visible = True
Dim x
On Error Resume Next
For x = 1 To Application.CommandBars.Count
With Application.CommandBars(x)
.Reset
.Enabled = True
End With

Next x
MsgBox 'L'archivage est terminer, le dossier d'archive a été placer sur le bureau, penser à changer son nom en rajoutant la date exp:08-05-2005'
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End Sub

Message édité par: Vinvinsylvain, à: 01/10/2005 14:39

 

[mutzik]

Bonjour VinVinSylvain

Quand il saura dire bonjour et éventuellement merci, peut-être il aura des réponses ...

 

[Vinvinsylvain]

Bonjour mutzik
désoler mais s'est la première fois que j'oublie les formules de polithèse je suis vraiment navrer d'avoir oublier!!!!!!!!!!!!!!!!!!
je te souhaite une bonne après midi.

 

[Hervé]

Bonjour sylvain, mutzik, le forum

Pour renommer un dossier, tu peux essayer ce type de code :

Sub Bouton1_QuandClic()
Dim toto As Object

Set toto = CreateObject('Scripting.FileSystemObject')
toto.movefolder 'c:\\archives', 'c:\\archives' & Format(Date, 'dd-mm-yyyy')
End Sub

A toi bien sur d'adapter les chemins et noms.

salut

 

[Vinvinsylvain]

Génial, merci beaucoup ton cote fonctionne a merveille, merci encore