"macro excel création et effacement auto&quot [Résolu]

Réponse 1 / 22

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
10 avril 2009 à 14:50

En faite j'arrive a créer le sous dossier mais il ne me crèè pas mes fichiers excel dans ce sous dossier; Et en plus il me crèe les fichiers dans le dossier principal avec un nom de la forme--->10_04_2009test- 10-4-2009 - 14H50m26s.xls

Réponse 2 / 22

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
10 avril 2009 à 14:54

remettons tout cela pour faire de l'ordre...
Le but est de faire une macro qui enregistre automatiquement (toutes les heures si j'ai bien compris) un classeur excel dans un répertoire "du jour" et qui à l'ouverture supprime d'anciennes sauvegardes de ce fichier. Nous en étions là du code :

Sub creation() 'fonction qui créé le sous-répertoire à la date du jour et effectue les sauvegardes de ton classeur
Dim Chemin As String
Dim fname As String
Dim jour As String
jour = Format(Date, "dd_mm_yyyy")
MkDir "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & jour
debut:
Start = Timer
intervalle = 60
Do While Timer < Start + intervalle
DoEvents ' Donne le contrôle à d'autres processus.
Loop
Chemin = "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\"
fname = Chemin & "test- " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Hour(Time) & "H" & Minute(Time) & "m" & Second(Time) & "s" & ".xls"
ActiveWorkbook.SaveCopyAs FileName:=fname
GoTo debut
End Sub

Sub auto_open() 'fonction qui supprime les anciennes sauvegardes
Dim var, Fic As String
var = InputBox("Saisir la date à laquelle vous souhaitez effacer les fichiers. Attention bien saisir au format dd_mm_yyyy!!", "date d'effacement")
Fic = Dir("\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & var)
If Fic <> "" Then
Kill "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & Fic
Else
MsgBox ("le sous-dossier que vous souhaitez effacer est vide. Veuillez vérifier.")
End If
End Sub

Private Sub Workbook_Open() 'ta macro
Dim Chemin As String
Dim fichierTexte As String
Chemin = "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\"
NomFic = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".txt"
If Dir(Chemin & NomFic) = "" Then 'si le fichier de la date du jour n'existe pas
Call auto_open ' on lance l'effacement
Set fs = CreateObject("Scripting.FileSystemObject") 'on crée le fichier date du jour
Set a = fs.CreateTextFile(Chemin & NomFic, True)
a.Close
Call creation 'on appelle l'autre proc
End If ' Il n'y a pas de sinon puisque si le fichier existe on ne fait rien
Call creation 'on appelle l'autre proc
End Sub

Réponse 3 / 22

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
10 avril 2009 à 14:59

Oui c'est bien ça!! Nous somme là

Réponse 4 / 22

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
10 avril 2009 à 15:01

J'ai pris ce code et je vais l'éxécuter

Réponse 5 / 22

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
10 avril 2009 à 15:03

J'ai éxécuter le code sans changement et j'ai cette erreur---> erreur d'exécution '75' ---> erreur d'accès chemin/Fichier et c'est sur mkdir--->MkDir "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & jour.

Réponse 6 / 22

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
10 avril 2009 à 15:08

Oui en fait, une fois que ton sous-répertoire est créé il plante car on ne peux pas créer 2 répertoire au même nom. Ca n'est pas un souci...

Réponse 7 / 22

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
10 avril 2009 à 15:11

Oui mais j'ai le repertoire qui se crèe quan même . Le truc aussi c'est que la macro ne crèe pa les fichiers dans mon sous dossier alors qu'elle devrai le faire

Réponse 8 / 22

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
10 avril 2009 à 15:26

oui je suis en train de chercher pour cela... Par contre ils sont tous sauvegardés dans ton rép "Mes Documents" non?

Réponse 9 / 22

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
10 avril 2009 à 15:30

Non ; mon fichier test est sur mon bureau et mes sauvegarde je les mets sur un serveur distant. Je te remercie mec pour ton aide précieuse

Réponse 10 / 22

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
10 avril 2009 à 16:14

Voici pour la sub creation :

Sub creation()
Dim Chemin As String
Dim fname As String
Dim jour As String
jour = Format(Date, "dd_mm_yyyy")
Chemin = "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & jour
If Dir(Chemin, vbDirectory) = "" Then 'ça je n'ai pas testé........
MkDir Chemin
End If
debut:
Start = Timer
intervalle = 60
Do While Timer < Start + intervalle
DoEvents
Loop
fname = "test- " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Hour(Time) & "H" & Minute(Time) & "m" & Second(Time) & "s" & ".xls"
ActiveWorkbook.SaveCopyAs Chemin & "\" & fname
GoTo debut
End Sub

Réponse 11 / 22

Utilisateur anonyme
10 avril 2009 à 16:15

Bonjour, permettez moi de rvenir dans cette nouvelle discussion

jah_haile_selassie, quand tu dis:

Oui mais j'ai le repertoire qui se crèe quan même . Le truc aussi c'est que la macro ne crèe pa les fichiers dans mon sous dossier alors qu'elle devrai le faire

ben effectivement , mais si tu regardais le code pour le comprendre tu verrais que:

dans ta sub creation on crée un répertoire:

jour = Format(Date, "dd_mm_yyyy")
MkDir "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & jour

et on sauvegarde les fichiers dans:

Chemin = "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\"
fname = Chemin & "test- " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Hour(Time) & "H" & Minute(Time) & "m" & Second(Time) & "s" & ".xls"
ActiveWorkbook.SaveCopyAs FileName:=fname

quand tu dis :

J'ai éxécuter le code sans changement et j'ai cette erreur---> erreur d'exécution '75' ---> erreur d'accès chemin/Fichier et c'est sur mkdir--->MkDir "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & jour.

Le répertoire est crée sans vérifier qu'il existe déjà! De plus dans la proc Workbook_Open() , à la premiere ouverture de ton classeur tu fais appel 2 fois à ta proc 'creation' . Il faut supprimer l'appel qui est dans le if......end if.

Le but est bientôt atteint
bon courage

Réponse 12 / 22

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
10 avril 2009 à 16:50

Oui comme dit Priouman j'avance! mais a trop petit pas mais merci a vous les mecs! sincèrement... J'ai modifié mon appel de la creation dans le bloc if...end...if comme me l'as conseillé Priouman. J'ai copié la sub creation de Pijaku. J'arrive a créer mon sous dossier et sauvegarder des fichiers dans ce sous-dossier ce que je n'arrivait pas a faire précedemment.
Une question persiste pourquoi on me demande la date a laquelle je veux supprimer des fichiers même quand je n'ai pas encore de sous dossier créé? Et en plus ma suppression de fichier il me dit tjrs que le sous dossier est vide alors qu'il contient des fichiers excels? Ce qui veut dire que ma suppression ne fonctionne plus :(
Merci et merci encore car c'est pas facile d'aider quelqu'un avec autant de difficulté mais bon je suis pour comprendre ce p*t** de langage.
Bonne soirée.

Jah

Réponse 13 / 22

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
10 avril 2009 à 17:03

Bon premier pallier atteints, la fonction creation fonctionne bien.
2ème pallier maintenant, l'effacement...
Au passage je m'excuse auprès des modérateurs pour la longueur de nos 2 topics, mais nous débutons et on y va pas à pas pour bien comprendre ce que l'on fait...
question 1 : pourquoi on me demande la date a laquelle je veux supprimer des fichiers même quand je n'ai pas encore de sous dossier créé?
réponse : on a placé une inputbox pour cela. Si tu veux qu'elle ne s'ouvre que si tu as des anciennes sauvegardes, il faut d'abord faire un test :
Sub auto_open()
Dim var, Fic As String
If Dir("\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\", vbDirectory) <> "" Then
var = InputBox("Saisir la date à laquelle vous souhaitez effacer les fichiers. Attention bien saisir au format dd_mm_yyyy!!", "date d'effacement")
else
exit sub
end if
question 2 : Et en plus ma suppression de fichier il me dit tjrs que le sous dossier est vide alors qu'il contient des fichiers excels?
réponse : euh plus le temps, je regarderais ça ce soir ou ce week end. Ou alors quelqu'un d'autre peux t'il te répondre??? Le problème se trouve dans ces quelques lignes :
Fic = Dir("\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & var)
If Fic <> "" Then
Kill "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & Fic '?????
Else
MsgBox ("le sous-dossier que vous souhaitez effacer est vide. Veuillez vérifier.")
End If
End Sub

Réponse 14 / 22

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
10 avril 2009 à 19:07

Maintenant voyons voir l'effacement (la sub complète!!!) Attention les yeux ça décoiffe!!! (elle n'est pas de moi, je l'ai pompé sur un autre forum mais comme il n'y a que CCM qui compte, on s'en fiche non???)
L'inputbox est maintenant inutile. En effet, nous avons créé des sous-dossiers et c'est ça qu'il faut effacer :

Sub auto_open()
Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
FS.Deletefolder "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\*.*"
End Sub

Je récapitule donc la macro en entier :

Private Sub Workbook_Open() 'la macro s'exécute à l'ouverture du classeur
Dim Chemin, NomFic As String
Chemin = "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\"
NomFic = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".txt"
If Dir(Chemin & NomFic) = "" Then 'si le fichier de la date du jour n'existe pas
Call auto_open ' on lance l'effacement
Set fs = CreateObject("Scripting.FileSystemObject") 'on crée le fichier date du jour
Set a = fs.CreateTextFile(Chemin & NomFic, True)
a.Close
End If ' Il n'y a pas de sinon puisque si le fichier existe on ne fait rien
Call creation 'on appelle l'autre proc
End Sub

Sub creation()
Dim Chemin, fname, jour As String
jour = Format(Date, "dd_mm_yyyy")
Chemin = "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & jour
If Dir(Chemin, vbDirectory) = "" Then 'Si le sous-dossier nommé "jour" d'aujourd"hui n'a pas encore été créé
MkDir Chemin 'et ben... on le créé
End If
debut:
Start = Timer
intervalle = 60
Do While Timer < Start + intervalle
DoEvents
Loop
fname = "test- " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Hour(Time) & "H" & Minute(Time) & "m" & Second(Time) & "s" & ".xls"
ActiveWorkbook.SaveCopyAs Chemin & "\" & fname
GoTo debut
End Sub

Sub auto_open()
Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
FS.Deletefolder "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\*.*"
End Sub

Voilà une bien jolie macro qui devrait figurer dans les astuces de CCM!!!
Mais avant tout, teste la pour vérifier tout ça.

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
14 avril 2009 à 10:54

Bonjour a tous!
Merci a vous les mecs pour les efforts fourni! Et surtout merci au forum coment-ça-marche!

J'ai testé le code. Il fonctionne bien du point de vu fonctionnel et de syntaxe. J'ai tjrs le problème de supprimer certains fichiers dans des sous dossiers de sauvegarde. En effet a l'état actuel du code ma procédure d'effacement(auto_open) elle m'efface systèmatiquement tout les sous dossier de sauvegarde qui ne sont pas nommés avec le nom de la date actuelle et en plus je n'ai plus ma question de savoir a quelle date voulez-vous effacer vos fichiers? Et au vu du code c'est normal étant donné que Pijaku a enlévé cette question.
--------------------------------------------Voici le code d'effacement de Pijaku-----------------------------------------
Sub auto_open()
Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
FS.Deletefolder "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\*.*"
End Sub

------------------------------------Voici le code que j'ai fait mais ça ne marche pas------------------------------------
Sub auto_open()
Dim var As String
If Dir("\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\", vbDirectory) <> "" Then
Set FS = CreateObject("Scripting.FileSystemObject")
var = InputBox("Saisir la date à laquelle vous souhaitez effacer les fichiers. Attention bien saisir au format dd_mm_yyyy!!", "date d'effacement")
FS.Deletefolder "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\*.*"
End If
End Sub
J'ai remis ma question pour effacer juste certains sous dossier car le code que j'ai testé efface tout le contenu des sous dossier qui ne sont pas a la date actuelle.

Merci pour l'aide.

Réponse 15 / 22

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
14 avril 2009 à 13:02

Salut,
Tu dois définir var avant de tester si le dossier existe.
Tu as fait ceci :
If Dir("\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\", vbDirectory) <> "" Then
Set FS = CreateObject("Scripting.FileSystemObject")
var = InputBox("Saisir la date à laquelle vous souhaitez effacer les fichiers. Attention bien saisir au format dd_mm_yyyy!!", "date d'effacement")
Donc d'abord tu testes l'existence de ton dossier et ensuite tu en définit le nom.....
Fais comme ceci :
var = InputBox("Saisir la date à laquelle vous souhaitez effacer les fichiers. Attention bien saisir au format dd_mm_yyyy!!", "date d'effacement")
If Dir("\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & var, vbDirectory) <> "" Then
Set FS = CreateObject("Scripting.FileSystemObject")
ensuite pour effacer le sous dossier tu avais :
FS.Deletefolder "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\*.*"
*.* = tous les sous-dossiers... Donc à remplacer par :
FS.Deletefolder "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & var
Je pense que cela fonctionne. Par contre vérifier ou placer le "& var" si c'est dans les guillemets ou non ça je ne sais plus...

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
14 avril 2009 à 13:35

Slt;
J'ai fais ceci:

Sub auto_open()
Dim var As String
Dim FS
var = InputBox("Saisir la date à laquelle vous souhaitez effacer les fichiers. Attention bien saisir au format dd_mm_yyyy!!", "date d'effacement")

If Dir("\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\" & var, vbDirectory) <> "" Then
Set FS = CreateObject("Scripting.FileSystemObject")
Else
FS.Deletefolder "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\ & var "
End If
End Sub.

J'ai testé avec var hors guillemet et dans guillemet mais rien a faire ma macro d'effacement ne se lance pas.

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009 > jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
14 avril 2009 à 13:39

Et pourquoi avoir écrit Dim FS au lieu de Dim FS As String? et quand je l'écrit ainsi Dim FS As String il me met une erreur de compilation :(

Réponse 16 / 22

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
14 avril 2009 à 15:02

euuhhhhh... J'en sais rien, comme je te disais plus haut je l'ai pompé intégralement sur Internet et te l'ai remise comme ça, intégralement sans chercher à comprendre... Il s'agit certainement d'une procédure vba propre à excel... Mais je dis certainement une grosse c***erie...

Réponse 17 / 22

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
14 avril 2009 à 15:13

Oui en effet j'ai cette erreur parceque FS n'est pas un string mais un Objet bon enfin c'est l'explication que j'ai vu par rapport a l'erreur car quand je met Dim FS As String l'erreur me dit Objet requis

Réponse 18 / 22

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
14 avril 2009 à 15:16

Sinon ta macro fonctionne maintenant ?

Réponse 19 / 22

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
14 avril 2009 à 15:50

oui elle fonctionne bien pour me créer mes fichiers dans les sous dossiers mais c'est a l'effaçage que je bute tjrs! J'arrive a effacer l'ensemble des sous dossiers mais effacer un dossier en particulier nada!

J'ai cherché un peu ailleurs et j'ai eu ça:
Sub auto_open()
Dim myFso, myFile, myFolder
Set myFso = CreateObject("Scripting.FileSystemObject")
'sélection du dossier à analyser
Set myFolder = myFso.GetFolder("\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\")
'boucle sur tous les fichier du dossier
For Each myFile In myFolder.Files
'si la date de modification du fichier est antérieure à 3 jours, effacer le fichier
If DateDiff("d", myFile.DateLastModified, Now) > 1 Then myFile.Delete True
Next myFile
End Sub
Mais avec ça la différence c'est que ça ne tien pas compte des noms fichiers étant donné que les fichiers son sous cette forme:test- 14-4-2009 - 15H24m45s.xls. Et ça ne tient pas compte peut-etre de mes sous dossiers lol harff casse-tête japonais

Réponse 20 / 22

jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
14 avril 2009 à 15:56

L'effacement fonctionne mais la je ne sais pas comment l'obliger a effacer dans les sous dossiers ou bien arréter la création des fichiers dans des sous dossier mais dans le dossier principal!

"macro excel création et effacement auto&quot

22 réponses

Newsletters