Bonjour,
J'ai un problème avec cette boucle, je n'arrive pas à exécuter l'écriture
des données dans un fichier et supprimer celui-ci.
For Each objFile in fic
Set f = fso.GetFile(objfile)
If DateDiff("D", objfile.DateCreated, now) > 7 Then
'MsgBox objfile & " a suprimer" & objfile.DateCreated
'On Error Resume Next
Set f = fso.OpenTextFile("c:\temp\vmtrans.txt", ForAppending,true)
f.write(objfile & " " & objfile.DateCreated)
f.write(Chr(10)+Chr(13))
f.close
fso.DeleteFile f, True
End if
Next
Comment faire pour que cette boucle fonctionne ?
Merci d'avance pour votre aide
Salutations
DIP
C'est de faire une boucle pour supprimer les répertoires et sous répertoires qui sont vides (récursivité)
Pour ça ... la vie serait si belle si un répertoire de taille zéro était *toujours* vide ... _MAIS_ ... :
'---8<---Effacer_Sous_Repertoires_Vides.VBS---Jean-JMST-Belgium--- ' ' Efface les sous-répertoires vides d'un répertoire
repertoire="W:Mon Répertoire"
With WScript.Arguments If .Count Then repertoire=.Item(0) End With
Effacer_Sous_Repertoires_Vides(repertoire)
WScript.Quit 0
Sub Effacer_Sous_Repertoires_Vides(dossier) ExecuteGlobal("b=Array():c=Array()") With CreateObject("Scripting.FileSystemObject") If Not .FolderExists(dossier) Then WScript.Quit 1 Set dossier=.GetFolder(dossier) Sous_Repertoires(dossier) For x=UBound(c) To 0 Step -1 If Not Possede(c(x),b) Then On Error Resume Next 'si en cours d'utlisation par une appli .DeleteFolder(c(x)) On Error GoTo 0 End If WScript.Sleep 1 Next End With End Sub
Sub Sous_Repertoires(dossier) For Each r1 in dossier.SubFolders If r1.Size=0 Then If r1.Files.Count Then Set r2=r1 ReDim Preserve b(UBound(b)+1) b(UBound(b))=r2.ShortPath While Not r2.IsRootFolder Set r2=r2.ParentFolder If Not Possede(r2.ShortPath,b) Then ReDim Preserve b(UBound(b)+1) b(UBound(b))=r2.ShortPath End If WScript.Sleep 1 Wend Else ReDim Preserve c(UBound(c)+1) c(UBound(c))=r1.ShortPath End If End If WScript.Sleep 1 Sous_Repertoires r1 Next End Sub
Function Possede(quoi,dansquoi) Possedeúlse For i=0 To UBound(dansquoi) If LCase(dansquoi(i))=LCase(quoi) Then Possede=True Exit Function End If WScript.Sleep 1 Next End Function
... si ce répertoire ou un de ses sous-répertoires contient un (ou des) fichier(s) de taille zéro ... le répertoire a une taille zéro _MAIS_ n'est pas vide ...
Amicalement,
-- Jean - JMST Belgium
C'est de faire une boucle pour supprimer les répertoires et sous
répertoires
qui sont vides (récursivité)
Pour ça ... la vie serait si belle si un répertoire de taille zéro
était *toujours* vide ... _MAIS_ ... :
'---8<---Effacer_Sous_Repertoires_Vides.VBS---Jean-JMST-Belgium---
'
' Efface les sous-répertoires vides d'un répertoire
repertoire="W:Mon Répertoire"
With WScript.Arguments
If .Count Then repertoire=.Item(0)
End With
Effacer_Sous_Repertoires_Vides(repertoire)
WScript.Quit 0
Sub Effacer_Sous_Repertoires_Vides(dossier)
ExecuteGlobal("b=Array():c=Array()")
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(dossier) Then WScript.Quit 1
Set dossier=.GetFolder(dossier)
Sous_Repertoires(dossier)
For x=UBound(c) To 0 Step -1
If Not Possede(c(x),b) Then
On Error Resume Next 'si en cours d'utlisation par une appli
.DeleteFolder(c(x))
On Error GoTo 0
End If
WScript.Sleep 1
Next
End With
End Sub
Sub Sous_Repertoires(dossier)
For Each r1 in dossier.SubFolders
If r1.Size=0 Then
If r1.Files.Count Then
Set r2=r1
ReDim Preserve b(UBound(b)+1)
b(UBound(b))=r2.ShortPath
While Not r2.IsRootFolder
Set r2=r2.ParentFolder
If Not Possede(r2.ShortPath,b) Then
ReDim Preserve b(UBound(b)+1)
b(UBound(b))=r2.ShortPath
End If
WScript.Sleep 1
Wend
Else
ReDim Preserve c(UBound(c)+1)
c(UBound(c))=r1.ShortPath
End If
End If
WScript.Sleep 1
Sous_Repertoires r1
Next
End Sub
Function Possede(quoi,dansquoi)
Possedeúlse
For i=0 To UBound(dansquoi)
If LCase(dansquoi(i))=LCase(quoi) Then
Possede=True
Exit Function
End If
WScript.Sleep 1
Next
End Function
... si ce répertoire ou un de ses sous-répertoires contient un (ou des)
fichier(s) de taille zéro ... le répertoire a une taille zéro _MAIS_
n'est pas vide ...
C'est de faire une boucle pour supprimer les répertoires et sous répertoires qui sont vides (récursivité)
Pour ça ... la vie serait si belle si un répertoire de taille zéro était *toujours* vide ... _MAIS_ ... :
'---8<---Effacer_Sous_Repertoires_Vides.VBS---Jean-JMST-Belgium--- ' ' Efface les sous-répertoires vides d'un répertoire
repertoire="W:Mon Répertoire"
With WScript.Arguments If .Count Then repertoire=.Item(0) End With
Effacer_Sous_Repertoires_Vides(repertoire)
WScript.Quit 0
Sub Effacer_Sous_Repertoires_Vides(dossier) ExecuteGlobal("b=Array():c=Array()") With CreateObject("Scripting.FileSystemObject") If Not .FolderExists(dossier) Then WScript.Quit 1 Set dossier=.GetFolder(dossier) Sous_Repertoires(dossier) For x=UBound(c) To 0 Step -1 If Not Possede(c(x),b) Then On Error Resume Next 'si en cours d'utlisation par une appli .DeleteFolder(c(x)) On Error GoTo 0 End If WScript.Sleep 1 Next End With End Sub
Sub Sous_Repertoires(dossier) For Each r1 in dossier.SubFolders If r1.Size=0 Then If r1.Files.Count Then Set r2=r1 ReDim Preserve b(UBound(b)+1) b(UBound(b))=r2.ShortPath While Not r2.IsRootFolder Set r2=r2.ParentFolder If Not Possede(r2.ShortPath,b) Then ReDim Preserve b(UBound(b)+1) b(UBound(b))=r2.ShortPath End If WScript.Sleep 1 Wend Else ReDim Preserve c(UBound(c)+1) c(UBound(c))=r1.ShortPath End If End If WScript.Sleep 1 Sous_Repertoires r1 Next End Sub
Function Possede(quoi,dansquoi) Possedeúlse For i=0 To UBound(dansquoi) If LCase(dansquoi(i))=LCase(quoi) Then Possede=True Exit Function End If WScript.Sleep 1 Next End Function
... si ce répertoire ou un de ses sous-répertoires contient un (ou des) fichier(s) de taille zéro ... le répertoire a une taille zéro _MAIS_ n'est pas vide ...