Discussion :

[DryArt]

Bonjour

Je cherche à contrôler les dates de création des fichiers dans un dossier et si celui est trop vieux (ici supérieur à 185 jours) ce fichier est supprimé. Cependant le code ne marche pas... Il m'affiche "erreur de compilation type defini par l'utilisateur non defini", je n'arrive pas à trouve le problème dans le code ci-dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Sub Supprime(Repertoire)
 
    Dim Fso As Object
    Dim Fichier As Folder
    Dim FileItem As File
 
 
    Set Fso = New FileSystemObject
 
With Fso
    Set Fichier = Fso.GetFolder(Repertoire)
 
       Cells(1, 2) = Format(Date, "dd-mmmm-yyyy")
 
       For Each FileItem In Fichier.Files
 
         Cells(1, 1) = FileItem.DateCreated
         Columns("A:A").Select
         Selection.NumberFormat = "General"
 
            If (Cells(1, 2).Value - Cells(1, 1).Value) > 185 Then
            FileItem.delete
            End If
 
 
        Next FileItem
End Sub

En vous remerciant par avance pour votre aide

[kiki29]

Salut, visiblement tu mélanges un peu tout : late binding et early binding d'ou tes problèmes.
Regarde Lister les fichiers d'un répertoire par ordre décroissant de date de création, après tu peux passer en Late Binding pour éviter de cocher certaines références.

Sinon concernant Manipulation des fichiers en VBA

Plutôt que de les détruire directement de façon définitive, les déplacer dans la corbeille. Voir ici.

[patricktoulon]

Bonjour
exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub test()
    Supprime ("D:\FILM TV")
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Supprime(Repertoire)
    Dim datefichier As Date
    Dim Fso As Object
    Dim Fichier As Object
    Dim FileItem As Object
    Set Fso = CreateObject("Scripting.FileSystemObject")
    With Fso
        Set Fichier = Fso.GetFolder(Repertoire)
        For Each FileItem In Fichier.Files
            i = i + 1
            datefichier = Format(FileItem.DateCreated, "dd/mm/yyyy")
            difference = Val(DateDiff("d", Date, datefichier))
 
            Cells(i, 1) = datefichier
            Cells(i, 2) = difference
 
             If difference < -185 Then
            Cells(i, 3) = True
            'FileItem.Delete
            End If
        Next FileItem
    End With
End Sub

quand tu aura compris comment ca marche tu pourra supprimer les lignes 10,14,15,18 et donc plus besoins d'utiliser le sheets pour analyse
ps: j'ai bloqué la ligne de suppression débloque la
adapte le chemin du dossier dans la sub test

[jerome.vaussenat]

Dim Fichier As Folder
Dim FileItem As File

Salut, à ma connaissance ces deux types ne sont pas gérés en standard en VBA.

Pour plus d'info:
la gestion des fichiers en VBA
http://warin.developpez.com/access/fichiers/
les variables en VBA
http://silkyroad.developpez.com/VBA/LesVariables/

[patricktoulon]

de toute facon pour ce genre de chose vaut mieux utiliser les déclarations tardives (late binding)
et donc tout en object comme ca pas de conflit

selon les versions d' excel et donc office (64/32 byte) et donc vba 7/vba6

[DryArt]

Re

Je vous remercie de votre aide, effectivement après avoir lu l'explication late Binding j'ai compris une des mes erreurs. Je faisait clairement n'importe quoi dans mes déclarations .

J'ai aboutiau code suivant qui réponds à mes attentes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Sub Supprime(Repertoire)
 
    Dim Fso As Object
    Dim Fichier As Object
    Dim FileItem As Object
 
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Fichier = Fso.GetFolder(Repertoire)
 
       Cells(1, 2).Value = DateValue(Date)
 
       For Each FileItem In Fichier.Files
 
        Cells(1, 1).Value = DateValue(FileItem.DateCreated)
 
            If (Cells(1, 2).Value - Cells(1, 1).Value) > 185 Then
                FileItem.delete
            End If
 
        Next FileItem
End Sub

Merci encore pour votre aide ( et les liens conseil)

[kiki29]

Salut, histoire de rajouter une couche, à ajouter dans un module, pour envoyer les fichiers dans la corbeille
et non les supprimer définitivement. je parle par expérience .....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Option Explicit
 
Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    sFrom As String
    sTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type
 
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
                                         (ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40
 
Sub DeplacerFichierDansCorbeille(sNomFichier As String)
Dim oFilAPI As SHFILEOPSTRUCT
Dim iRet As Long
 
    With oFilAPI
        .wFunc = FO_DELETE
        .sFrom = sNomFichier
        .sTo = vbNullChar
        .fFlags = FOF_SILENT + FOF_NOCONFIRMATION + FOF_ALLOWUNDO
    End With
 
    iRet = SHFileOperation(oFilAPI)
End Sub

Tu peux l'appeler depuis le module1 via Module2.DeplacerFichierDansCorbeille (NomDuFichier)

[patricktoulon]

Bonjour kiki

avec environ on trouve pas la poubelle par hasard??
peut être qu'avec move et le environ poubelle on peut se passer de l'api ???