VBA sauvegarde clef USB récalcitrante

[gaelick]

Bonsoir à tous, bonsoir au forum XLD et à tous les excéliens !
Voici mon grooooooooos problème.
J'ai crée une macro qui quand on ferme le fichier (17 megas!) par la croix en haut à droite sauvegarde sur place et enregistre le fichier dans le disque dur "maître" jusque là rien de bien nouveau mais en suivant il envoie et sauvegarde sur une clef USB ce même fichier en ajoutant la date et l'heure dans le titre. Mais en plus il fait cela 7 fois puis arrivé à la 8° il "écrase" la 1° sauvegarde
(de sorte que sur la clef il ne doit rester que les 7 dernières sauvegardes).
Ouep mais problème il y a... Le débogueur dit = Erreur d'execution 70ermission refusée sur FichSauv.Delete
Je joins mon code.
------------------
Sub SauvegardeClasseur1()
Dim Nom As String, Fichier As String, Jour As String, Mois As String, Année As String, Heure1 As String, Heure2 As String
'Permet de sauvegarder le classeur sur son emplacement, rien d'extraordinaire'
ActiveWorkbook.Save
'Mise en forme de la date et l'heure. Le 0 semble permettre de gérer la forme "04" janvier au lieu de "4" janvier''
Année = Year(Date)
Mois = Format(Month(Date), "0#")
Jour = Format(Day(Date), "0#")
Heure1 = Format(Hour(Time), "0#")
Heure2 = Format(Minute(Time), "0#")
'Mise en forme de la dénomination de la sauvegarde'
Fichier = "Happy Hour 7.8 " & "du " & Année & "-" & Mois & "-" & Jour & " à " & Heure1 & "H" & Heure2
'Chemin de destination'
Fichier = "E:\SauvegardeFichiers\" & Fichier
'Mise en forme de la sauvegarde'
ActiveWorkbook.SaveAs Filename:=Fichier, FileFormat:=xlNormal
'Début de la partie gestion des archives de sauvegarde'
Dim Dossier As Object, FichSauv As Object
Dim Chemin As String, Nb As Byte
'Indication du chemin où se trouve la sauvegarde'
Chemin = "E:\SauvegardeFichiers\"
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
'Gestion des 7 sauvegardes avec écrasement systématique de la plus ancienne'
Nb = Dossier.Files.Count
For Each FichSauv In Dossier.Files
If Nb > 7 Then
FichSauv.Delete
Exit Sub
End If
Next
Application.Quit
End Sub
--------------------------
Je soumet mon problème à votre sagacité.
J'ai essayé de virer le End If mais evidemment ça march pô
Etc etc Je suis à cours d'arguments. Pouvez vous m'aider
Merci d'avance
XP Pro SP2 - Excel 2000

 

[Guillaumega]

Re : VBA sauvegarde clef USB récalcitrante

Je suis ravi que ma modeste contribution à un post de 3 sheets ait été productive... ce d'autant que de grandes star du vba sont passées avant moi.

Pour la précision rien ne t'empêche de concatener ce que tu veux à la fin de tes fichiers à partir du moment où le début commence bien par le numéro de version, ce dernier étant LE PARAMETRE définisant l'ancienneté de la sauvegarde.

Bien à toi et bonnes fêtes!

 

[Guillaumega]

Re : VBA sauvegarde clef USB récalcitrante

Merci Jean Pierre je sais que je ne suis pas toujours pertinent. Mais comment veux-tu que je sois aussi fort que toi avec si peu d'expérience...
Et puis tu m'aides alors j'essaie d'aider les autres aussi en retour... quitte à passer pour un idiot de temps en temps/souvent?.

Re,

Pour Guillaméga, sur ce fil et sur d'autres ??????????????????????????????????????????????????????

 

[ninbihan]

Re : VBA sauvegarde clef USB récalcitrante

Bonjour et meilleurs voeux pour cette nouvelle année,

Voici mon dernier essai avec filedatetime :

Sub SauvegardeClasseur1()

'Début de la partie gestion des archives de sauvegarde'
Dim Dossier As Object, FichSauv As Object
Dim Chemin As String, Nb As Byte, vdate As Variant
'Indication du chemin où se trouve la sauvegarde'
Chemin = "E:\SauvegardeFichiers\"
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
'Gestion des 7 sauvegardes avec écrasement systématique de la plus ancienne'
'détermination de la version la plus ancienne
vdate = Now
For Each FichSauv In Dossier.Files
If FileDateTime(FichSauv) < vdate Then vdate = FileDateTime(FichSauv)
Next

Nb = Dossier.Files.Count
For Each FichSauv In Dossier.Files
If Nb > 6 And FileDateTime(FichSauv) = vdate Then
FichSauv.Delete
Nb = Dossier.Files.Count
End If
Next
Dim Nom As String, Fichier As String, Jour As String, Mois As String, Année As String, Heure1 As String, Heure2 As String
'Permet de sauvegarder le classeur sur son emplacement, rien d'extraordinaire'
ActiveWorkbook.Save
'Mise en forme de la date et l'heure. Le 0 semble permettre de gérer la forme "04" janvier au lieu de "4" janvier''
Année = Year(Date)
Mois = Format(Month(Date), "0#")
Jour = Format(Day(Date), "0#")
Heure1 = Format(Hour(Time), "0#")
Heure2 = Format(Minute(Time), "0#")
'Mise en forme de la dénomination de la sauvegarde'
Fichier = "Happy Hour 7.8 " & "du " & Année & "-" & Mois & "-" & Jour & " à " & Heure1 & "H" & Heure2
'Chemin de destination'
Fichier = "E:\SauvegardeFichiers\" & Fichier & ".xls"
'Mise en forme de la sauvegarde'
ActiveWorkbook.SaveAs Filename:=Fichier, FileFormat:=xlNormal

Application.Quit
End Sub

A tester,

Bonne journée,

Ninbihan