Code ne fonctionne pas pour les sous dossiers

Version imprimable

17/02/2012, 16h57
archi57

Code ne fonctionne pas pour les sous dossiers
Bonjour à tous,

j'aimerai savoir pourquoi ce code VBS ne recherche pas les fichiers log ou bak dans les sous-dossiers ?
Code:

1 2 3 4 Const DeleteReadOnly = True Set objFSO = CreateObject("Scripting.FileSystemObject") objFSO.DeleteFile("C:\Down\*.log"), DeleteReadOnly objFSO.DeleteFile("C:\Down\*.bak"), DeleteReadOnly
merci par avance
@+

bonjour,
et comme ça ?

Code:

1
2
3
4
Const DeleteReadOnly = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile "C:\Down\*.log", DeleteReadOnly
objFSO.DeleteFile "C:\Down\*.bak", DeleteReadOnly

17/02/2012, 18h27
archi57

Merci Omen
j'ai toujours un message d'erreur :"Ligne 3 caractère 1" !!
que faire ?

:salut:

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
Dim Dossier 'Nom du répertoire à parcourir
Dim oFSO,oFld,oSubFolder,strFileSize,ws,NomFichierLog,temp,PathNomFichierLog,OutPut,ext
ext = Array("log","bak") 'extensions à supprimer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell" )
Title = "Suppression des Fichiers"
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
NomFichierLog= "Fichiers Supprimés_"& Day(Now)&"_"& Month(Now)&"_"& year(Now) &".txt"
Set OutPut = oFSO.OpenTextFile(NomFichierLog,2,True)
Dossier = "C:\Down\"
'On verifie que le repertoire existe 
If (myName = Winrep = oFSO.FolderExists(Dossier)) = False Then 
    Erreur = MsgBox("Le dossier est introuvable !",16,"Test d'existence du dossier" ) 
    Wscript.Quit 
End If 
 
Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function
 
ParcoursRep Dossier
OutPut.Writeline Cstr(NbFichiersEffaces) + " fichiers en total ont été supprimés avec succés !"
 
Sub ParcoursRep (stRep )
    MsgBox "On Traite le Répertoire : " & qq(stRep),64,qq(stRep)
    If oFSO.FolderExists(stRep) Then
    Set oFld = oFSO.GetFolder(stRep)
    end If
output.writeLine "Le Nom et le chemin du répertoire :" & qq(oFld.Path)  & " et il contient " & oFld.SubFolders.count & " sous-répertoires"
output.writeline String(100,"*")
 
For i = lbound(ext) to ubound(ext) 
For each File in oFld.Files
If UCase(ext(i)) = UCase(oFSO.GetExtensionName(File.Name)) Then 
OutPut.WriteLine File.Path 
Msgbox File.Path,64,File.Path
File.Delete()
NbFichiersEffaces = NbFichiersEffaces + 1 
End If 
Next
Next
output.writeLine "Il y a "& oFld.Files.count & " Fichiers dans le dossier "& qq(oFld.Path) &_
"et "& Cstr(NbFichiersEffaces) & " Fichiers qui ont été supprimés !"
output.writeline String(100,"*")
 
    For each oSubFolder in oFld.subFolders
        ParcoursRep oSubFolder.Path 'appel récursif de la procédure
    Next
end sub
 
OutPut.Writeline Cstr(NbFichiersEffaces) + " fichiers ont été supprimés !"
MsgBox (Cstr(NbFichiersEffaces) + " fichiers ont été supprimés !" ),64,Cstr(NbFichiersEffaces) + " fichiers ont été effacés"

18/02/2012, 13h48
archi57

Merci hackoofr,
effectivement ça n'a rien a voir mon code !!
cela correspondant parfaitement a mes attentes !!
:ccool:
18/02/2012, 14h08
archi57

petite question tous de même, comment éviter d'avoir le fichier "Fichiers Supprimés...txt" créer après chaque opération ?
@+
18/02/2012, 14h31
hackoofr

Citation:

Envoyé par archi57

petite question tous de même, comment éviter d'avoir le fichier "Fichiers Supprimés...txt" créer après chaque opération ?
@+

supprime les lignes de output et output.writeline

je viens d'essayer, malheureusement j'ai un message d'erreur...j'ai dû enlevé une ligne de trop...mais laquelle ?!

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
Dim Dossier 'Nom du répertoire à parcourir
Dim oFSO,oFld,oSubFolder,strFileSize,ws,NomFichierLog,temp,PathNomFichierLog,OutPut,ext
ext = Array("log","bak","bak0") 'extensions à supprimer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell" )
Title = "Suppression des Fichiers"
'Comptage des fichiers effaces 
NbFichiersEffaces = 0
NomFichierLog= "Fichiers Supprimés_"& Day(Now)&"_"& Month(Now)&"_"& year(Now) &".txt"
Dossier = "C:\Mes documents Archi\"
'On verifie que le repertoire existe 
If (myName = Winrep = oFSO.FolderExists(Dossier)) = False Then 
Erreur = MsgBox("Le dossier est introuvable !",16,"Test d'existence du dossier" ) 
Wscript.Quit 
End If
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function
ParcoursRep Dossier
Sub ParcoursRep (stRep )
If oFSO.FolderExists(stRep) Then
Set oFld = oFSO.GetFolder(stRep)
end If
For i = lbound(ext) to ubound(ext) 
For each File in oFld.Files
If UCase(ext(i)) = UCase(oFSO.GetExtensionName(File.Name)) Then
File.Delete()
NbFichiersEffaces = NbFichiersEffaces + 1 
End If 
Next
Next
"et "& Cstr(NbFichiersEffaces) & " Fichiers qui ont été supprimés !"
For each oSubFolder in oFld.subFolders
ParcoursRep oSubFolder.Path 'appel récursif de la procédure
Next
end sub
MsgBox (Cstr(NbFichiersEffaces) + " fichiers ont été supprimés avec succés !" ),64,Cstr(NbFichiersEffaces) + " fichiers ont été effacés"

18/02/2012, 15h09
SfJ5Rpw8

Citation:

Envoyé par archi57

je viens d'essayer, malheureusement j'ai un message d'erreur

et bien lit le ce message !

et il dit quoi le message d'erreur ? sur qu'elle ligne l'erreur ? :aie:
18/02/2012, 15h18
archi57

erreur ligne 32 caractère 1 !!
18/02/2012, 15h24
archi57

c'est bon j'ai trouvé la ligne en trop !!
"et "& Cstr(NbFichiersEffaces) & " Fichiers qui ont été supprimés !"

merci pour tous
@+