Code pour suppresion fichier en fonction de la date de modif

Le 24/01/2014 à 12:46

bonjour à tous et toutes.....

voici ci dessous ma macro pour supprimer automatiquement les fichiers mp3 et Wav (déjà est ce que *mp3*wav est correct ?) des dossiers de mes agents...... je souhaiterai rajouter une ligne pour demander à ce que ne soient supprimés que les fichiers ayant plus de 5 jours en fonction de leur date de modification...... quel code rajouter et ou?

merci beaucoup!

bonne journée à tous

Sub SupprContenu()

Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & Range("C2").Value & " ?", vbYesNo + vbCritical, "Attention")

If Msg = vbYes Then

Dim Fic As String

Fic = DirF:\services\Dossier Personnel\agent X\Appels Enregistrés\*.mp3*.wav")

Do While Fic <> ""

Kill "F:\services\Dossier Personnel\agent X\Appels Enregistrés\" & Fic

Fic = Dir

Loop

End If

End Sub

Le 24/01/2014 à 12:56

Si ça ne tenait qu'à moi j'utiliserais la classe directory info plutôt que de tripper avec des dir

      Dim directory As New IO.DirectoryInfo("F:\services\Dossier Personnel\agent X\Appels Enregistrés")

        For Each file As IO.FileInfo In directory.GetFiles
            If file.Extension.Equals(".wav") AndAlso (Now - file.CreationTime).Days > 5 Then
                file.Delete()
            End If

            If file.Extension.Equals(".mp3") AndAlso (Now - file.CreationTime).Days > 5 Then
                file.Delete()
            End If

        Next
Le 24/01/2014 à 13:04

re,

merci pour la rapidité.... je viens de refaire mon code mais ça me met en rouge tout ce que j'ai surligné....

Sub SupprContenu()

Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & Range("C2").Value & " ?", vbYesNo + vbCritical, "Attention")

If Msg = vbYes Then

Dim directory As New IO.DirectoryInfo("F:\services\Dossier Personnel\agent X\Appels Enregistrés")

For Each file As IO.FileInfo In directory.GetFiles

If file.Extension.Equals(".wav") Andalso (Now - file.CreationTime).Days > 5 Then

file.Delete()

End If

If file.Extension.Equals(".mp3") AndAlso (Now - file.CreationTime).Days > 5 Then

file.Delete()

End If

NextEnd Sub

Le 24/01/2014 à 13:50

déjà il te manque un end if...

Le 24/01/2014 à 15:04

merci pour la réponse.... mais ça bloque toujours sur la partie "Dim directory".... il me dit "attendu fin de compilation" ???

Sub SupprContenu()

End Sub

Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & Range("C2").Value & " ?", vbYesNo + vbCritical, "Attention")

If Msg = vbYes Then

Dim directory As NewIO.DirectoryInfo ("F:\services\sophia\Dossier Personnel CS\Albinet Christian\Appels Enregistrés")

For Each file As IO.FileInfo In directory.GetFiles

If file.Extension.Equals(".wav") Andalso (Now - file.CreationTime).Days > 5 Then

file.Delete()

End If

If file.Extension.Equals(".mp3") AndAlso (Now - file.CreationTime).Days > 5 Then

file.Delete()

End If

End If

Next

End Sub

Le 24/01/2014 à 15:41

J'étais dans un projet avec un framework .net et je n'ai pas réflechi.. Excuse ma bêtise.

active la référence microsoft scripting runtime ou truc dans le genre.

Sub toto()
    Dim fso, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder("F:\services\sophia\Dossier Personnel CS\Albinet Christian\Appels Enregistrés")
    Set fc = f.Files
    Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & Range("C2").Value & " ?", vbYesNo + vbCritical, "Attention")
    If Msg = vbYes Then
        For Each f1 In fc
            If f1.DateLastModified < DateAdd("d", -5, Now) And (Right(f1.Path, 3) = wav Or Right(f1.Path, 3) = "mp3") Then
                f1.Delete
            End If
        Next f1
    End If
End Sub
Le 24/01/2014 à 15:58

super !!!!

ça marche merci beaucoup.....

j'ai juste rajouté les guillements sur la ligne 9 à "Wav"

autre question......

si je veux rajouter d'autres fichiers où faire cela, avec des noms de personnes différents.....

est ce que je peux déplacer ces lignes

Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & Range("C2").Value & " ?", vbYesNo + vbCritical, "Attention")

If Msg = vbYes Then

sous la ligne sub toto et recopier le bloc .........

exemple:

Sub toto()

Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & Range("C2").Value & " ?", vbYesNo + vbCritical, "Attention")

If Msg = vbYes Then

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder("F:\services\sophia\Dossier Personnel CS\Agent N°1\Appels Enregistrés")

Set fc = f.Files

Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & Range("C2").Value & " ?", vbYesNo + vbCritical, "Attention")

If Msg = vbYes Then

For Each f1 In fc

If f1.DateLastModified < DateAdd("d", -5, Now) And (Right(f1.Path, 3) = "wav" Or Right(f1.Path, 3) = "mp3") Then

f1.Delete

End If

Next f1

End If

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder("F:\services\sophia\Dossier Personnel CS\Agent N°2\Appels Enregistrés")

Set fc = f.Files

Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & Range("C2").Value & " ?", vbYesNo + vbCritical, "Attention")

If Msg = vbYes Then

For Each f1 In fc

If f1.DateLastModified < DateAdd("d", -5, Now) And (Right(f1.Path, 3) = "wav" Or Right(f1.Path, 3) = "mp3") Then

f1.Delete

End If

Next f1

End If

End Sub

Le 24/01/2014 à 16:20

Comprend rien à ce que tu racontes..

Le 26/01/2014 à 15:35

Bonjour engue engue....

Désole pour ma description......

En fait je veux garder ma message box au début.....

Et rajouter le code macro pour d autres fichiers......

En fait ma macro ira supprimer des fichiers dans environ 70 dossiers .....

Je comptais donc recopier les lignes en changeant le répertoire source...

Je m exprime mieux?

Merci de l aide

Le 27/01/2014 à 10:52

Un million de façons de faire.. Si tu connais les chemins donne lui en argument, sinon mets un textbox ou un truc pour aller le parcourir...

Sub toto(chemin as string)
    Dim fso, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(chemin)
    Set fc = f.Files
    Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & chemin & " ?", vbYesNo + vbCritical, "Attention")
    If Msg = vbYes Then
        For Each f1 In fc
            If f1.DateLastModified < DateAdd("d", -5, Now) And (Right(f1.Path, 3) = wav Or Right(f1.Path, 3) = "mp3") Then
                f1.Delete
            End If
        Next f1
    End If
End Sub
sub listefichiers()
call toto("F:\services\sophia\Dossier Personnel CS\Agent N°1\Appels Enregistrés")
call toto("F:\services\sophia\Dossier Personnel CS\Agent N°2\Appels Enregistrés")
....
end sub
Le 28/01/2014 à 11:24

bonjour.....

je comprends pas trop.....

le "call " est un autre code?

merci

Le 28/01/2014 à 14:31

LE call appelle la routine en lui filant un argument nom de dossier...

Si je veux supprimer 50 dossiers alors je fais 50 calls de la routine toto

Le 28/01/2014 à 15:30

re, est ce que je peux pas plutot rajouter une ligne "Set f=..... pour chaque dossier? car là je comprends pas.....

Sub toto()

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder("F:\services\sophia\Dossier Personnel CS\aGENT 1\Appels Enregistrés")

Set f = fso.GetFolder("F:\services\sophia\Dossier Personnel CS\AGENT 2

Set f = fso.GetFolder("F:\services\sophia\Dossier Personnel CS\agent 3

.........Set fc = f.Files

Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & Range("C2").Value & " ?", vbYesNo + vbCritical, "Attention")

If Msg = vbYes Then

For Each f1 In fc

If f1.DateLastModified < DateAdd("d", -5, Now) And (Right(f1.Path, 3) = wav Or Right(f1.Path, 3) = "mp3") Then

f1.Delete

End If

Next f1

End If

End Sub

Le 28/01/2014 à 15:32

non

Le 28/01/2014 à 16:17

comment faire alors? car je comprends pas .....

merci de votre aide car je suis vraiement pas expert !!

Le 28/01/2014 à 16:24

10h52 hier tu as eu ta réponse.

Le 28/01/2014 à 16:30

oui j'ai vu....

j'ai copié les 2 codes l'un en dessous de l'autre et il me marque "argument non facultatif"

c'est pour ça que je comprends pas non plus.....

merci des réponses et de votre patience !!

Le 30/01/2014 à 09:07

bonjour à tous....

quelqu'un pour m'aider ???

merci à tous de votre collaboration....

bonne journée

Le 31/01/2014 à 10:15

bonjour, bon j'ai trouvé .... j'ai fait un code de ce type..... c'est pas l'ideal mais ça marche

merci à tous pour votre aide.....

Sub toto()

Msg = MsgBox("Voulez vous supprimer les appels des dossiers CS " & Range("C2").Value & " ?", vbYesNo + vbCritical, "Attention")

If Msg = vbYes Then

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder("F:\services\sophia\Dossier Personnel CS\aGENT 1\Appels Enregistrés")

Set fc = f.Files

For Each f1 In fc

If f1.DateLastModified < DateAdd("d", -5, Now) And (Right(f1.Path, 3) = wav Or Right(f1.Path, 3) = "mp3") Then

f1.Delete

End If

Next f1

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder("F:\services\sophia\Dossier Personnel CS\aGENT 2\Appels Enregistrés")

Set fc = f.Files

For Each f1 In fc

If f1.DateLastModified < DateAdd("d", -5, Now) And (Right(f1.Path, 3) = wav Or Right(f1.Path, 3) = "mp3") Then

f1.Delete

End If

Next f1

End If

End Sub

Rechercher des sujets similaires à "code suppresion fichier fonction date modif"