compter les repertoires commencant par Sauvegarde au *

Le
sylvie.laurent82
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

On Error GoTo GestErr

ChDrive E:
repertoire = 'comment définir cela ici ?????????????????

nf = Dir(repertoire)
Do While nf <> ""

dt = FileDateTime(repertoire & nf)

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é "

Exit Sub

GestErr:

MsgBox "Erreur numéro: " & Err.Number & " , voir SL !!!", vbCritical

End Sub

pourriez-vous s'il vous plait me préter main forte ?

Merci à vous et à tout'

SylVBA
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Philippe.R
Le #18185691
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
news:
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

On Error GoTo GestErr

ChDrive E:
repertoire = 'comment définir cela ici ?????????????????

nf = Dir(repertoire)
Do While nf <> ""

dt = FileDateTime(repertoire & nf)

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é "

Exit Sub

GestErr:

MsgBox "Erreur numéro: " & Err.Number & " , voir SL !!!", vbCritical

End Sub

pourriez-vous s'il vous plait me préter main forte ?

Merci à vous et à tout'

SylVBA
sylvie.laurent82
Le #18187751
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
Le #18188711
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
Le #18193181
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
LSteph
Le #18193601
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






Daniel.C
Le #18195031
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








Publicité
Poster une réponse
Anonyme