Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Delete

11 réponses
Avatar
DIP
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

1 réponse

1 2
Avatar
Jean
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

'---8<---Effacer_Sous_Repertoires_Vides.VBS---Jean-JMST-Belgium---


... 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

1 2