compter les repertoires commencant par Sauvegarde au *
6 réponses
sylvie.laurent82
Bjr =E0 vous,
J'ai sur une cl=E9 usb (E) des dossier (avec sous rep) qui se nomment
Sauvegarde au * (le * repr=E9sente une date sur la forme 08122008 etc )
Je souhaite compter les repertoires qui r=E9pondednt =E0 cette condition
et si il sont plus vieux que 10 jours les effacer
Comment cel est ce possible ?
J'avais d=E9j=E0 eu un coup de main de JB, mais impossible de retrouver la
piste compl=E8te,
Voila le d=E9but du code
Sub SupprimeSauveTropAncienne()
Dim Lastt As Date, x As Integer, Pluriel As String
Lastt =3D Date - 20
If CDate(dt) < Lastt Then
MsgBox CDate(dt) 'pour les tests
'Kill repertoire & nf ' =E0 la fin pour effacer
x =3D x + 1
End If
nf =3D Dir
Loop
If x =3D 0 Then Exit Sub
If x > 1 Then Pluriel =3D "s"
MsgBox x & " Sauvegarde" & Pluriel & " ancienne" & Pluriel & "
effac=E9e" & Pluriel & " avec succ=E8s !!", vbExclamation, "Lib=E9ration de
place dans la cl=E9 "
J'ai sur une clé usb (E) des dossier (avec sous rep) qui se nomment Sauvegarde au * (le * représente une date sur la forme 08122008 etc ) Je souhaite compter les repertoires qui répondednt à cette condition et si il sont plus vieux que 10 jours les effacer
Comment cel est ce possible ?
J'avais déjà eu un coup de main de JB, mais impossible de retrouver la piste complète,
Voila le début du code Sub SupprimeSauveTropAncienne()
Dim Lastt As Date, x As Integer, Pluriel As String Lastt = Date - 20
If CDate(dt) < Lastt Then MsgBox CDate(dt) 'pour les tests 'Kill repertoire & nf ' à la fin pour effacer x = x + 1
End If nf = Dir Loop
If x = 0 Then Exit Sub
If x > 1 Then Pluriel = "s"
MsgBox x & " Sauvegarde" & Pluriel & " ancienne" & Pluriel & " effacée" & Pluriel & " avec succès !!", vbExclamation, "Libération de place dans la clé "
pourriez-vous s'il vous plait me préter main forte ?
Merci à vous et à tout'
SylVBA
Bonjour,
Pour lister les dossiers :
http://frederic.sigonneau.free.fr/code/Fichiers/ListeDossiersSousDossiers.txt
ne reste plus alors qu'à boucler sur la partie du nom qui contient la date
pour en avoir l'âge et utiliser la commande Delete si la condition est
remplie
--
Avec plaisir
http://dj.joss.free.fr/trombine.htm
http://jacxl.free.fr/mpfe/trombino.html
Philippe.R
Pour se connecter au forum :
http://www.excelabo.net/mpfe/connexion.php
News://news.microsoft.com/microsoft.public.fr.excel
<sylvie.laurent82@wanadoo.fr> a écrit dans le message de
news:c018c98f-31fb-4d1f-ad74-b53dae473b3d@q26g2000prq.googlegroups.com...
Bjr à vous,
J'ai sur une clé usb (E) des dossier (avec sous rep) qui se nomment
Sauvegarde au * (le * représente une date sur la forme 08122008 etc )
Je souhaite compter les repertoires qui répondednt à cette condition
et si il sont plus vieux que 10 jours les effacer
Comment cel est ce possible ?
J'avais déjà eu un coup de main de JB, mais impossible de retrouver la
piste complète,
Voila le début du code
Sub SupprimeSauveTropAncienne()
Dim Lastt As Date, x As Integer, Pluriel As String
Lastt = Date - 20
If CDate(dt) < Lastt Then
MsgBox CDate(dt) 'pour les tests
'Kill repertoire & nf ' à la fin pour effacer
x = x + 1
End If
nf = Dir
Loop
If x = 0 Then Exit Sub
If x > 1 Then Pluriel = "s"
MsgBox x & " Sauvegarde" & Pluriel & " ancienne" & Pluriel & "
effacée" & Pluriel & " avec succès !!", vbExclamation, "Libération de
place dans la clé "
J'ai sur une clé usb (E) des dossier (avec sous rep) qui se nomment Sauvegarde au * (le * représente une date sur la forme 08122008 etc ) Je souhaite compter les repertoires qui répondednt à cette condition et si il sont plus vieux que 10 jours les effacer
Comment cel est ce possible ?
J'avais déjà eu un coup de main de JB, mais impossible de retrouver la piste complète,
Voila le début du code Sub SupprimeSauveTropAncienne()
Dim Lastt As Date, x As Integer, Pluriel As String Lastt = Date - 20
If CDate(dt) < Lastt Then MsgBox CDate(dt) 'pour les tests 'Kill repertoire & nf ' à la fin pour effacer x = x + 1
End If nf = Dir Loop
If x = 0 Then Exit Sub
If x > 1 Then Pluriel = "s"
MsgBox x & " Sauvegarde" & Pluriel & " ancienne" & Pluriel & " effacée" & Pluriel & " avec succès !!", vbExclamation, "Libération de place dans la clé "
Je connais le site de frédéric, mais sincèrement, je n'arrive pas a modifier mon code correctement,
Le code que j'ai fonctionne bien pour des fichiers pas pour des rep et sous rep
Please help !!
Y aurait il une âme charitable pour un petit coup de main ?
Merci d'avance à vosu,
Syl VBA
Daniel.C
Bonsoir. Utilise la macro "RechercheDossiers" (d'après une macro de JB) Change la ligne : racine = "e:" suivant tes besoins. La macro affiche le chemin du dossier chaque fois qu'elle en trouve un. Remplace le mgbox par ton code. Sub RechercheDossiers() 'Crédit JB racine = "e:" Set fso = CreateObject("Scripting.FileSystemObject") Set dossier_racine = fso.getfolder(racine) Lit_dossier dossier_racine End Sub Sub Lit_dossier(ByRef dossier) For Each d In dossier.SubFolders Lit_dossier d If Left(d.Name, 13) = "Sauvegarde au" Then MsgBox d.Path End If Next End Sub
Cordialement. Daniel
Merci Philippe,
Je connais le site de frédéric, mais sincèrement, je n'arrive pas a modifier mon code correctement,
Le code que j'ai fonctionne bien pour des fichiers pas pour des rep et sous rep
Please help !!
Y aurait il une âme charitable pour un petit coup de main ?
Merci d'avance à vosu,
Syl VBA
Bonsoir.
Utilise la macro "RechercheDossiers" (d'après une macro de JB)
Change la ligne :
racine = "e:"
suivant tes besoins.
La macro affiche le chemin du dossier chaque fois qu'elle en trouve un.
Remplace le mgbox par ton code.
Sub RechercheDossiers()
'Crédit JB
racine = "e:"
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
If Left(d.Name, 13) = "Sauvegarde au" Then
MsgBox d.Path
End If
Next
End Sub
Cordialement.
Daniel
Merci Philippe,
Je connais le site de frédéric, mais sincèrement, je n'arrive pas a
modifier mon code correctement,
Le code que j'ai fonctionne bien pour des fichiers pas pour des rep et
sous rep
Please help !!
Y aurait il une âme charitable pour un petit coup de main ?
Bonsoir. Utilise la macro "RechercheDossiers" (d'après une macro de JB) Change la ligne : racine = "e:" suivant tes besoins. La macro affiche le chemin du dossier chaque fois qu'elle en trouve un. Remplace le mgbox par ton code. Sub RechercheDossiers() 'Crédit JB racine = "e:" Set fso = CreateObject("Scripting.FileSystemObject") Set dossier_racine = fso.getfolder(racine) Lit_dossier dossier_racine End Sub Sub Lit_dossier(ByRef dossier) For Each d In dossier.SubFolders Lit_dossier d If Left(d.Name, 13) = "Sauvegarde au" Then MsgBox d.Path End If Next End Sub
Cordialement. Daniel
Merci Philippe,
Je connais le site de frédéric, mais sincèrement, je n'arrive pas a modifier mon code correctement,
Le code que j'ai fonctionne bien pour des fichiers pas pour des rep et sous rep
Please help !!
Y aurait il une âme charitable pour un petit coup de main ?
Merci d'avance à vosu,
Syl VBA
sylvie.laurent82
Merci Daniel C
je vais tester cela, tes explications me semblent claires,
Je te remercie vivement, je me penche sur le pb après les dernières courses !! ce soir ou demain matin et je reviens, bien sur, te donner mes commentaires et remerciements d'usage,
Quel bonheur de vous avoir auprès de nous,
A +
Bon dimanche à vous tous,
SylVBA
Merci Daniel C
je vais tester cela, tes explications me semblent claires,
Je te remercie vivement, je me penche sur le pb après les dernières
courses !! ce soir ou demain matin et je reviens, bien sur, te donner
mes commentaires et remerciements d'usage,
je vais tester cela, tes explications me semblent claires,
Je te remercie vivement, je me penche sur le pb après les dernières courses !! ce soir ou demain matin et je reviens, bien sur, te donner mes commentaires et remerciements d'usage,
Quel bonheur de vous avoir auprès de nous,
A +
Bon dimanche à vous tous,
SylVBA
LSteph
msgbox "bonjour" 'Crédit matante
Daniel.C a écrit :
Bonsoir. Utilise la macro "RechercheDossiers" (d'après une macro de JB) Change la ligne : racine = "e:" suivant tes besoins. La macro affiche le chemin du dossier chaque fois qu'elle en trouve un. Remplace le mgbox par ton code. Sub RechercheDossiers() 'Crédit JB racine = "e:" Set fso = CreateObject("Scripting.FileSystemObject") Set dossier_racine = fso.getfolder(racine) Lit_dossier dossier_racine End Sub Sub Lit_dossier(ByRef dossier) For Each d In dossier.SubFolders Lit_dossier d If Left(d.Name, 13) = "Sauvegarde au" Then MsgBox d.Path End If Next End Sub
Cordialement. Daniel
Merci Philippe,
Je connais le site de frédéric, mais sincèrement, je n'arrive pas a modifier mon code correctement,
Le code que j'ai fonctionne bien pour des fichiers pas pour des rep et sous rep
Please help !!
Y aurait il une âme charitable pour un petit coup de main ?
Merci d'avance à vosu,
Syl VBA
msgbox "bonjour"
'Crédit matante
Daniel.C a écrit :
Bonsoir.
Utilise la macro "RechercheDossiers" (d'après une macro de JB)
Change la ligne :
racine = "e:"
suivant tes besoins.
La macro affiche le chemin du dossier chaque fois qu'elle en trouve un.
Remplace le mgbox par ton code.
Sub RechercheDossiers()
'Crédit JB
racine = "e:"
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
If Left(d.Name, 13) = "Sauvegarde au" Then
MsgBox d.Path
End If
Next
End Sub
Cordialement.
Daniel
Merci Philippe,
Je connais le site de frédéric, mais sincèrement, je n'arrive pas a
modifier mon code correctement,
Le code que j'ai fonctionne bien pour des fichiers pas pour des rep et
sous rep
Please help !!
Y aurait il une âme charitable pour un petit coup de main ?
Bonsoir. Utilise la macro "RechercheDossiers" (d'après une macro de JB) Change la ligne : racine = "e:" suivant tes besoins. La macro affiche le chemin du dossier chaque fois qu'elle en trouve un. Remplace le mgbox par ton code. Sub RechercheDossiers() 'Crédit JB racine = "e:" Set fso = CreateObject("Scripting.FileSystemObject") Set dossier_racine = fso.getfolder(racine) Lit_dossier dossier_racine End Sub Sub Lit_dossier(ByRef dossier) For Each d In dossier.SubFolders Lit_dossier d If Left(d.Name, 13) = "Sauvegarde au" Then MsgBox d.Path End If Next End Sub
Cordialement. Daniel
Merci Philippe,
Je connais le site de frédéric, mais sincèrement, je n'arrive pas a modifier mon code correctement,
Le code que j'ai fonctionne bien pour des fichiers pas pour des rep et sous rep
Please help !!
Y aurait il une âme charitable pour un petit coup de main ?
Merci d'avance à vosu,
Syl VBA
Daniel.C
Bonsoir. ? Daniel
msgbox "bonjour" 'Crédit matante
Daniel.C a écrit :
Bonsoir. Utilise la macro "RechercheDossiers" (d'après une macro de JB) Change la ligne : racine = "e:" suivant tes besoins. La macro affiche le chemin du dossier chaque fois qu'elle en trouve un. Remplace le mgbox par ton code. Sub RechercheDossiers() 'Crédit JB racine = "e:" Set fso = CreateObject("Scripting.FileSystemObject") Set dossier_racine = fso.getfolder(racine) Lit_dossier dossier_racine End Sub Sub Lit_dossier(ByRef dossier) For Each d In dossier.SubFolders Lit_dossier d If Left(d.Name, 13) = "Sauvegarde au" Then MsgBox d.Path End If Next End Sub
Cordialement. Daniel
Merci Philippe,
Je connais le site de frédéric, mais sincèrement, je n'arrive pas a modifier mon code correctement,
Le code que j'ai fonctionne bien pour des fichiers pas pour des rep et sous rep
Please help !!
Y aurait il une âme charitable pour un petit coup de main ?
Merci d'avance à vosu,
Syl VBA
Bonsoir.
?
Daniel
msgbox "bonjour"
'Crédit matante
Daniel.C a écrit :
Bonsoir.
Utilise la macro "RechercheDossiers" (d'après une macro de JB)
Change la ligne :
racine = "e:"
suivant tes besoins.
La macro affiche le chemin du dossier chaque fois qu'elle en trouve un.
Remplace le mgbox par ton code.
Sub RechercheDossiers()
'Crédit JB
racine = "e:"
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
If Left(d.Name, 13) = "Sauvegarde au" Then
MsgBox d.Path
End If
Next
End Sub
Cordialement.
Daniel
Merci Philippe,
Je connais le site de frédéric, mais sincèrement, je n'arrive pas a
modifier mon code correctement,
Le code que j'ai fonctionne bien pour des fichiers pas pour des rep et
sous rep
Please help !!
Y aurait il une âme charitable pour un petit coup de main ?
Bonsoir. Utilise la macro "RechercheDossiers" (d'après une macro de JB) Change la ligne : racine = "e:" suivant tes besoins. La macro affiche le chemin du dossier chaque fois qu'elle en trouve un. Remplace le mgbox par ton code. Sub RechercheDossiers() 'Crédit JB racine = "e:" Set fso = CreateObject("Scripting.FileSystemObject") Set dossier_racine = fso.getfolder(racine) Lit_dossier dossier_racine End Sub Sub Lit_dossier(ByRef dossier) For Each d In dossier.SubFolders Lit_dossier d If Left(d.Name, 13) = "Sauvegarde au" Then MsgBox d.Path End If Next End Sub
Cordialement. Daniel
Merci Philippe,
Je connais le site de frédéric, mais sincèrement, je n'arrive pas a modifier mon code correctement,
Le code que j'ai fonctionne bien pour des fichiers pas pour des rep et sous rep
Please help !!
Y aurait il une âme charitable pour un petit coup de main ?