Macro qui efface fichiers ds un répertoire

[Gilles 28]

Bonsoir à tous et à toutes,
Je cherche une petite macro qui me permette de vider la corbeille de mon disque dur C et ensuite que cette macro vide TOUS les fichiers ce trouvant dans le répertoire C:\\_Travail.
Ces fichiers peuvent etre en lecture seule ou non mais tous doivent aller dans la corbeille qui vient d'etre vider.
Merci d'avance.
Gilles

 

[Bernard_XLD]

Bonjour gilles 28

ce que tu demandes est à ma connaissance sinon impossible du moins trés difficilement réalisable sans recours aux Api. S'il est facile d'effacer les fichiers avec VBA, ceux ci ne sont pas transférés à la corbeille.
je te propose un code qui déplacera tes fichiers dans un répertoire sauve.

Sub Sauve_Fichiers()
Dim Nom_Fichier As String, Rep_Travail As String, Rep_Sauve As String
Rep_Travail = 'c:\\travail\\'
Rep_Sauve = 'c:\\Sauve\\'
Do
Nom_Fichier = Dir(Rep_Travail & '*.*', vbNormal)
If Not (Nom_Fichier = '') Then Name Rep_Travail & Nom_Fichier As Rep_Sauve & Nom_Fichier
Loop Until Nom_Fichier = ''
End Sub

le code suivant te permet d'effacer directement les fichiers dans le répertoire de sauvegarde quand ils ne sont plus necessaires

Sub Supprime_Fichiers_Sauves()
Dim Nom_Fichier As String, Rep_Sauve As String
Rep_Sauve = 'c:\\Sauve\\'
Do
Nom_Fichier = Dir(Rep_Sauve & '*.*', vbNormal)
If Not (Nom_Fichier = '') Then Kill Rep_Sauve & Nom_Fichier
Loop Until Nom_Fichier = ''
End Sub

cela revient à peu prés à ce que tu demandes.

Cordialement, A+

 

[Bernard_XLD]

Re

trop vite répondu, contrairement au déplacement, la suppression ne fonctionne pas avec les fichiers en lecture seule.
voici un code modifié et fonctionnel. Il peut facilement évoluer pour supprimer les fichiers sur un critère de date ou autre.

A+

Public Const Rep_Travail = 'c:\\travail\\'
Public Const Rep_Sauve = 'c:\\sauve\\'
Sub Sauve_Fichiers()
Dim Nom_Fichier As String
Do
Nom_Fichier = Dir(Rep_Travail & '*.*', vbNormal)
If Not (Nom_Fichier = '') Then Name Rep_Travail & Nom_Fichier As Rep_Sauve & Nom_Fichier
Loop Until Nom_Fichier = ''
End Sub
Sub Supprime_Fichiers_Sauves()
    Dim Compteur As Integer
    Dim Objet_Fichier, Fichier
    Application.FileSearch.LookIn = Rep_Sauve
    Application.FileSearch.Filename = '*.*'
    If Application.FileSearch.Execute > 0 Then
        Set Objet_Fichier = CreateObject('Scripting.FileSystemObject')
        For Compteur = 1 To Application.FileSearch.FoundFiles.Count
            Set Fichier = Objet_Fichier.GetFile(Application.FileSearch.FoundFiles(Compteur))
            If Fichier.Attributes And 1 Then Fichier.Attributes = Fichier.Attributes - 1
            Fichier.Delete
        Next Compteur
    End If
End Sub

Message édité par: yeahou, à: 19/01/2006 23:19

 

[gilles 28]

Merci bien Yeahou ,
je te remercie et en plus avec quelle vitesse tu as repondu c'est genial.
J'ai regardé un peu tes codes et je me demandais s'il etait possible d'avoir un bouton qui effectue les 2 opérations en une seule fois.
C'est-à-dire d'abord effacer les fichiers du répertoire Sauve puis faire le transfert de Travail dans Sauve en un seul Click sur le bouton de la macro.
Ou il n'est peut-etre pas necessaire d'effacer dans Sauve si le transfert écrase tout sce qu'il y a dedans !
Gilles

 

[Bernard_XLD]

Bonjour

le voila en un seul code, je ne sais si déplacer des fichiers avec l'instruction name permet d'en écraser, à tester. Par contre il est sur que cela ne fonctionnerait avec des fichiers en lecture seule à écraser.

Cordialement, A+

Public Const Rep_Travail = 'c:\\travail\\'
Public Const Rep_Sauve = 'c:\\sauve\\'
Sub Sauvegarde()
Dim Nom_Fichier As String
    Dim Compteur As Integer
    Dim Objet_Fichier, Fichier
    Application.FileSearch.LookIn = Rep_Sauve
    Application.FileSearch.Filename = '*.*'
    If Application.FileSearch.Execute > 0 Then
        Set Objet_Fichier = CreateObject('Scripting.FileSystemObject')
        For Compteur = 1 To Application.FileSearch.FoundFiles.Count
            Set Fichier = Objet_Fichier.GetFile(Application.FileSearch.FoundFiles(Compteur))
            If Fichier.Attributes And 1 Then Fichier.Attributes = Fichier.Attributes - 1
            Fichier.Delete
        Next Compteur
    End If
    Do
    Nom_Fichier = Dir(Rep_Travail & '*.*', vbNormal)
    If Not (Nom_Fichier = '') Then Name Rep_Travail & Nom_Fichier As Rep_Sauve & Nom_Fichier
    Loop Until Nom_Fichier = ''
End Sub

 

[JCGL]

Bonjour Yeahou, Gilles 28, Le Forum

Je me suis permis de pomper ton code...
Cela faisait un moment que je cherchais aussi.

Merci encore


PS : j'ai du remplacer Public par Private et enlever un espace en trop dans En d IF

 

[gilles28]

je n'ai qu'un mot a dire superbe
et encore merci
a+
gillles

 

[Bernard_XLD]

Re

pas de problème, JCGL, il est la pour cela.
pour l'espace dans le end if, je ne sais pas comment il est arrivé la!
Le fait de remplacer public par Private ne fera que rendre inaccessible la variable aux macros issues d'un autre module, sinon cela ne gène pas.

A+

 

[Gilles 28]

Snif,
je ne m'en sors pas:
avec:
Public Const Rep_Travail = 'c:\\travail\\'
Public Const Rep_Sauve = 'c:\\sauve\\'
les lignes sont rouges et j'ai erreur de compil:erreur de syntax

avec:
Private Const Rep_Travail = 'c:\\travail\\'
j'ai erreur de compil:attrib incorrect ds une procédure Sub ou fonction

avec:
Private Rep_Travail = 'c:\\travail\\'
j'ai erreur de compil:erreur de syntax

Merci

Si tu pouvais me poster le fichier excel se serait bien cool.

Je suis sous Excel 2003 au fait et Win XP.

Merci

 

[JCGL]

Bonsoir Gilles 28, Yeahou

La macro de Yeahou fonctionne parfaitement chez moi avec la même config que toi.

Juste pour le fun : as-tu pensé à créer les répertoires sources et destination si tu as repris le code de Yeahou et il manque un anti-slash

Public Const Rep_Travail = 'c:travail'
Public Const Rep_Sauve = 'c:sauve'
les lignes sont rouges et j'ai erreur de compil:erreur de syntax

C:'anti-slash' Travail 'anti-slash'

Message édité par: JCGL, à: 21/01/2006 21:29

 

[gilles 28]

oui \\ sont mis

je post le fichier

merci de ta reponse pux-tu post ton fichier svp avec la mocro merci.

C'est pas vous qui m'inqueter c'est moi. je me demande si je ne deviens pas un ane

Y'a 2 fois rien je pense!!

Gilles

 

[gilles28]

le fichier si ca marche !

 

[gilles28]

re [file name=efface.zip size=8854]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/efface.zip[/file]

 

[JCGL]

Bonsoir Gille 28,

Ca m'embète de spolier Yeahou : c'est quand même lui qui a créé le code.

Cela serait un manque de fair-play

Message édité par: JCGL, à: 21/01/2006 21:47

 

[gilles 28]

tu as regarde ce qui differe entre nos 2 fichiers ?

Merci

Gilles