Problème avec la date de modification

Version imprimable

J'ai ceci :

Code:

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
 
     '*******************************************************************************
     ' Script permettant D 'effacer les fichiers Qui date de plus de 15 jours
     ' Avec interface Graphique
     '
     '*******************************************************************************
    Private Sub Form_Load()
 
 
 
     strComputer = "."
 
     Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set objShell = CreateObject("Shell.Application")
     Set objFolder = objShell.BrowseForFolder _
     (WINDOW_HANDLE, "Selectionner le dossier à traiter :", NO_OPTIONS, ".")
     Set objFolderItem = objFolder.Self
     strFolderName = objFolderItem.Path
 
     Set colSubfolders = objWMIService.ExecQuery _
     ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
     & "Where AssocClass = Win32_Subdirectory " _
     & "ResultRole = PartComponent")
 
     'Wscript.Echo strFolderName
 
     arrFolderPath = Split(strFolderName, "\")
     strNewPath = ""
     For i = 1 To UBound(arrFolderPath)
     strNewPath = strNewPath & "\\" & arrFolderPath(i)
     Next
     strPath = strNewPath & "\\"
 
     Set colFiles = objWMIService.ExecQuery _
     ("Select * from CIM_DataFile where Path = '" & strPath & "'")
 
     For Each objFile In colFiles
     Set objReadOnlyFile = objFSO.GetFile(objFile.Name)
     'Wscript.Echo objFile.Name & chr (10) & objReadOnlyFile.DateLastModified
     If DateDiff("d", objReadOnlyFile.DateLastModified, Date) > 15 Then
 
     objFile.Delete
     End If
     Next
 
     For Each objFolder In colSubfolders
     GetSubFolders strFolderName
     Next
 
    End Sub
    Sub GetSubFolders(strFolderName)
 
     Set colSubfolders2 = objWMIService.ExecQuery _
     ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
     & "Where AssocClass = Win32_Subdirectory " _
     & "ResultRole = PartComponent")
 
     For Each objFolder2 In colSubfolders2
     strFolderName = objFolder2.Name
     'Wscript.Echo
     'Wscript.Echo objFolder2.Name
     arrFolderPath = Split(strFolderName, "\")
     strNewPath = ""
     For i = 1 To UBound(arrFolderPath)
     strNewPath = strNewPath & "\\" & arrFolderPath(i)
     Next
     strPath = strNewPath & "\\"
 
     Set colFiles = objWMIService.ExecQuery _
     ("Select * from CIM_DataFile where Path = '" & strPath & "'")
 
     For Each objFile In colFiles
     Set objReadOnlyFile = objFSO.GetFile(objFile.Name)
     If DateDiff("d", objReadOnlyFile.DateLastModified, Date) > 15 Then
     'Wscript.Echo objFile.Name & chr (10) & objReadOnlyFile.DateLastModified
     objFile.Delete
 
     End If
 
     Next
 
     GetSubFolders strFolderName
     Next
     End Sub

Quand je choisis un dossier qui n'a pas de sous-dossier il marche ; mais quand je choisi un dossier qui a un sous-dossier il beugle ici :

Code:

1
2
3
4
     Set colSubfolders2 = objWMIService.ExecQuery _
     ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
     & "Where AssocClass = Win32_Subdirectory " _
     & "ResultRole = PartComponent")

Merci d'avance

25/03/2008, 19h55
SfJ5Rpw8

Citation:

Envoyé par imparator_42

.je choisi un dossier qui a un sous-dossier il beugle ici : ...

du verbe beugler ..? comme les vaches ..?

et il sort d'ou le beuglement ...? il n'est pas accompagné d'un message d'erreur ..?

je parierai bien sur la variable objet : objWMIService ... qui n'est déclaré nulle part.. :roll:
25/03/2008, 21h49
imparator_42

je ne sais pas pourquoi c'est écris beugler :( c'est à cause d'1 dico , quand je fait des fautes de frappes, y me les corrige :(

Mais y a un problème quand le dossier choisi a un sous-dossier qui contient des fichiers...
25/03/2008, 21h53
SfJ5Rpw8
Citation:

Envoyé par bbil

. ...? il n'est pas accompagné d'un message d'erreur ..?

je parierai bien sur la variable objet : objWMIService ... qui n'est déclaré nulle part.. :roll:

tiens essai une "rustine" rajoute la ligne :
Code:

1 2 Dim objWMIService
tout en haut de ton code ... , en dehors de toutes procédures ;)
27/03/2008, 00h05
imparator_42

Merci BBil :)
il n y a plus cet erreur :)
Mais il y en a un autre :(

=> Run-time Error "424"
Object Required

On me montrant la ligne :

Code:

Set objfileReadOnlyFile = objFSO.GetFile(objfile.Name)

snif :aie:
27/03/2008, 07h29
SfJ5Rpw8
c'est le même problème...

Tu utilise la varible objet OFso ... sans la déclarer .. d'ou VB ce charge de le faire , VB "générant" des variables locales tu te retrouve donc avec deux variables locales oFSO l'unle dans ta procédure Form_Load et l'autre dans la procédure GetSubFolders..La deuxième n'est pas initialisée d'ou ton erreur..

pour corriger cela utilise une variable oFSO globale à ton module en la déclarant tout en haut de ton code...(Dim oFSO ..)

pour éviter ce genre d'erreur je t'encourage à rajouter tout en haut de ton code la ligne :
Code:

1 2 Option explicit
cette option te force à déclarer explicitement toutes tes variables ..et évite ainsi ce genre d'erreur;)
27/03/2008, 09h04
imparator_42

le programme semble marchait un peu prés :d
mais des fois il me sors le message avec Switch to...
Merci BBil