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

 

[phlaurent55]

Re : VBA sauvegarde clef USB récalcitrante

gealick,

encore une autre erreur
tu oublie de sauver au format .xls

' maintenant le fichiertransit est sauvegardé en le renommant fichier1

ActiveWorkbook.SaveAs Filename:="E:\Classeur1" [COLOR="red"]c'est ici que ça merde[/COLOR] , FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

recorrige ! on y arrivera

 

[phlaurent55]

Re : VBA sauvegarde clef USB récalcitrante

gaelick,

3)Le classeur d'origine n'est pas enregistré sur son propre emplacement sur le disque dur

ça c'est à toi de le faire, je n'ai jamais fait de voyage dans ton disque dur,
jee n'en connais pas le nom des rues et les 'adresse' ou tu stokes tes fichiers

à+
Philippe

 

[gaelick]

Re : VBA sauvegarde clef USB récalcitrante

Bonsoir à tous,

Pour kiki29 = Ah je prends l'info et je l'applique effectivement ça marche il fait son quart d'heure de sauvegarde sans fenêtre pour valider la suite.

Pour phlaurent55 = Le code dans le classeur est bon c'est le copié collé qui à foiré un chouya par un dérapage intempestif

Je fouine, j'essaye mais les essais sont longs à chaque fois. Merci de m'aider

 

[gaelick]

Re : VBA sauvegarde clef USB récalcitrante

Re,

J'ai rajouté le .xls sur la dernière partie du code .
Mais bon il repart pour un tour complet.
C'est dommage on est pas loin !

 

[gaelick]

Re : VBA sauvegarde clef USB récalcitrante

Rebonsoir ,
Le code est =
-----------------
Sub SauvegardeClasseur1()
Application.DisplayAlerts = False
'le classeur actif est sauvegardé sous le mon "Classeur transit.xls"
ActiveWorkbook.SaveAs Filename:="E:\Classeurtransit.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
'et on le garde toujours actif donc pas de "ActiveWindow.Close"
Dim i As Integer
For i = 6 To 1 Step -1
Workbooks.Open Filename:="E:\Classeur" & i & ".xls"
ActiveWorkbook.SaveAs Filename:="E:\Classeur" & i + 1 & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close

Next i
' maintenant le fichiertransit est sauvegardé en le renommant fichier1
ActiveWorkbook.SaveAs Filename:="E:\Classeur1.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False


End Sub
-----------------------------
Sinon on ne sait plus ou on en est !

 

[gaelick]

Re : VBA sauvegarde clef USB récalcitrante

Bonsoir, rebonsoir,
Maintenant il continue à faire pareil mais j'ai pourtant sorti 2 bras et 3 jambes, voyez plutôt ! =
-------------------
Sub SauvegardeClasseur1()
Application.DisplayAlerts = False
'le classeur actif est sauvegardé sous le mon "Classeur transit.xls"

'et on le garde toujours actif donc pas de "ActiveWindow.Close"
Dim i As Integer
For i = 6 To 1 Step -1
Workbooks.Open Filename:="E:\Classeur" & i & ".xls"
ActiveWorkbook.SaveAs Filename:="E:\Classeur" & i + 1 & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close

Next i
' maintenant le fichiertransit est sauvegardé en le renommant fichier1
ActiveWorkbook.SaveAs Filename:="E:\Classeur1.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False


End Sub
----------------------------------
Etonnant non ???

 

[gaelick]

Re : VBA sauvegarde clef USB récalcitrante

Rebonsoir,
Là je viens de sortir la rate et qqs autres bricoles ! Mais il est imperturbable ce code il continue à écraser les 7 fichiers .xls de 17293 Ko allègrement. La clef est tellement chaude que je m'en sers de chauffage
Donc en fait le code fonctionne du feu de dieu sur des classeurs de qqs dizaine de ko mais dans mon cas , je vais devoir le modificationner
Nouveau code=
----------------
Sub SauvegardeClasseur1()
Application.DisplayAlerts = False

Dim i As Integer
For i = 6 To 1 Step -1
Workbooks.Open Filename:="E:\Classeur" & i & ".xls"
ActiveWorkbook.SaveAs Filename:="E:\Classeur" & i + 1 & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close

Next i
' maintenant le fichiertransit est sauvegardé en le renommant fichier1
ActiveWorkbook.SaveAs Filename:="E:\Classeur1.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False


End Sub
---------------------------------

 

[phlaurent55]

Re : VBA sauvegarde clef USB récalcitrante

Gealick,

fais un essai comme ceci:

vide tout ce que tu as dans ton répertoire E (si tu peux)

Crée un fichier excel qui contient la valeur "je suis le fichier 7" dans la case A1 et sauvegarde ce fichier en le nommant "classeur7".
Crée un fichier excel qui contient la valeur "je suis le fichier 6" dans la case A1 et sauvegarde ce fichier en le nommant "classeur6".
Crée un fichier excel qui contient la valeur "je suis le fichier 5" dans la case A1 et sauvegarde ce fichier en le nommant "classeur5".
Crée un fichier excel qui contient la valeur "je suis le fichier 4" dans la case A1 et sauvegarde ce fichier en le nommant "classeur4".
Crée un fichier excel qui contient la valeur "je suis le fichier 3" dans la case A1 et sauvegarde ce fichier en le nommant "classeur3".
Crée un fichier excel qui contient la valeur "je suis le fichier 2" dans la case A1 et sauvegarde ce fichier en le nommant "classeur2".
Crée un fichier excel qui contient la valeur "je suis le fichier 1" dans la case A1 et sauvegarde ce fichier en le nommant "classeur1".

Arrête Excel et ensuite redémarre-le
Ouvre uniquement le "classeur1"
Change la valeur de la cellule A1 en la remplaçant par "dernière sauvegarde"

Démarre la macro.

le résultat doit être le suivant:

le classeur7 doit contenir la valeur "je suis le fichier 6"
le classeur6 doit contenir la valeur "je suis le fichier 5"
le classeur5 doit contenir la valeur "je suis le fichier 4"
le classeur4 doit contenir la valeur "je suis le fichier 3"
le classeur3 doit contenir la valeur "je suis le fichier 2"
le classeur2 doit contenir la valeur "je suis le fichier 1"
le classeur1 doit contenir la valeur "dernière sauvegarde"

chez moi ça marche
tiens-moi au courrant !
à+

 

[gaelick]

Re : VBA sauvegarde clef USB récalcitrante

Rebonsoir phlaurent55

Non, non le code fonctionne bien c'est que le fichier est beaucoup trop lourd.
Le code en soit est bon ça s'est clair mais je peux pas l'utiliser tous les jours à cause du temps de fermeture qui est trop long. No problem man !
Je vais trouver un moyen terme entre ton code et celui de ninbihan.
C'est dommage parce qu'il met 10 (environ) secondes pour sauvegarder sur son propre emplacement (disque dur C\ et 12 mn (environ) sur la clef. C'est ballot comme dirait l'autre !

 

[JNP]

Re : VBA sauvegarde clef USB récalcitrante

Bonjour le forum ,
Peut-être devrais-tu envisager de changer de clef ...
Parce que 12 mn pour 17Mo sur une clef USB, c'est démoralisant .
Bonne année à tous

 

[gaelick]

Re : VBA sauvegarde clef USB récalcitrante

Bonsoir le forum,
Ouep c'est démoralisant mais la clef n'y est pour rien la pauvre. Pourtant ça tourne en USB 2.0 mais le prob c'est que excel sauvegarde en enregistrement mais ne fait pas de copie comme le ferait windows.
Je vais changer le code par copy plutot que save ? Est ce une bonne idée ???

 

[gaelick]

Re : VBA sauvegarde clef USB récalcitrante

Re,
Non pas bon erreur 438 evidemment

 

[phlaurent55]

Re : VBA sauvegarde clef USB récalcitrante

re,

c'est peut-être une réponse à la con, mais si tu mettais 'CreateBackup:=True'

Dim i As Integer
For i = 6 To 1 Step -1
Workbooks.Open Filename:="E:\Classeur" & i & ".xls"
ActiveWorkbook.SaveAs Filename:="E:\Classeur" & i + 1 & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=[COLOR="Red"]False[/COLOR]
ActiveWindow.Close

Ne serait-ce pas ton PC qui rame par manque de RAM
Courrage !

je pars une semaine pour changer d'air
je reviendrai voir sur ce fil vers le 4 janvier
tiens-nous au courrant de ta tension artérielle

et encore BONNE ANNEE A TOUS

 

[gaelick]

Re : VBA sauvegarde clef USB récalcitrante

Bonsoir,
Merci phlaurent55
No problem
Bonne vacances
Et a la prochaine sur ce fil qui j'espère d'ici la sera solutionné !
Ciao et encore many thanks man

 

[ninbihan]

Re : VBA sauvegarde clef USB récalcitrante

Bonjour à tous,

J'étais rester sur la solution de départ:

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
'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 > 6 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

J'ai testé et cela semble fonctionner

Joyeuse St Sylvestre à tous,

Ninbihan