Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

compter les repertoires commencant par Sauvegarde au *

6 réponses
Avatar
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

On Error GoTo GestErr

ChDrive E:
repertoire =3D 'comment d=E9finir cela ici ?????????????????

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

dt =3D FileDateTime(repertoire & nf)

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 "

Exit Sub

GestErr:

MsgBox "Erreur num=E9ro: " & Err.Number & " , voir SL !!!", vbCritical

End Sub

pourriez-vous s'il vous plait me pr=E9ter main forte ?

Merci =E0 vous et =E0 tout'

SylVBA

6 réponses

Avatar
Philippe.R
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
a écrit dans le message de
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
Avatar
sylvie.laurent82
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
Avatar
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


Avatar
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
Avatar
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






Avatar
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