Option Explicit
Const Titre = "Script de nettoyage des fichiers et sous-dossiers by Hackoo 2015"
Const strPath = "c:\test"
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strPath) Then
MsgBox "Erreur dans chemin du dossier """& strPath &"""",VbCritical,Titre
Wscript.Quit
End if
Call Cleanup(strPath)
MsgBox "Tous les fichiers et les sous-dossiers du répertoire """& strPath &""""& Vbcr &_
" ont été supprimés !",Vbinformation,Titre
'*******************************************************************
Sub Cleanup(str)
Dim objFolder,objSubFolder,objFile
Set objFolder = objFSO.GetFolder(str)
For Each objFile In objFolder.Files
objFile.Delete(True)
Next
For Each objSubFolder In objFolder.SubFolders
Cleanup(objSubFolder.Path)' appel récursive dans la même fonction
'Les fichiers ont été supprimés,on vérifie si le dossier est vide.
If (objSubFolder.Files.Count = 0) Then
objSubFolder.Delete True
End If
Next
End Sub
'******************************************************************
Set toto = CreateObject("Scripting.FileSystemObject")
toto.DeleteFile("d:\monoutil\*.*")
Set toto = CreateObject("Scripting.FileSystemObject")
Set titi = toto.GetFolder("d:\monoutil")
Set tata = titi.Subfolders
For Each objSubfolder in tata
Wscript.Echo objSubfolder.Name
Next
del /Q/S d:\bof\*.*
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionOption Explicit
Const Titre = "Script de nettoyage des fichiers et sous-dossiers by Hackoo 2015"
Dim objFSO,ws,strPath,Temp,Question
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")'Dossier temporaire
strPath = Temp
Question = Msgbox("ATTENTION ! "& vbcr &_
"Le script va effacer tous les fichiers et les sous-dossiers du dossier "& vbcr &_
DblQuote(Temp) & vbcr & "Voulez-vous continuer ou non ? ",VbYesNo+VbExclamation,Titre)
If Question = VbNo Then
Wscript.Quit
end if
If Question = VbYes Then
If Not objFSO.FolderExists(strPath) Then
MsgBox "Erreur dans chemin du dossier "& DblQuote(strPath),VbCritical,Titre
Wscript.Quit
End if
Call Cleanup(strPath)
end if
MsgBox "Tous les fichiers et les sous-dossiers du répertoire "& DblQuote(strPath) & Vbcr &_
" ont été supprimés !",Vbinformation,Titre
'*******************************************************************
Sub Cleanup(str)
On Error Resume Next
Dim objFolder,objSubFolder,objFile
Set objFolder = objFSO.GetFolder(str)
For Each objFile In objFolder.Files
objFile.Delete(True)
Next
For Each objSubFolder In objFolder.SubFolders
Cleanup(objSubFolder.Path)' appel récursive dans la même fonction
'Les fichiers ont été supprimés,on vérifie si le dossier est vide.
If (objSubFolder.Files.Count = 0) Then
objSubFolder.Delete True
End If
Next
End Sub
'******************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'******************************************************************
Option Explicit
Const Titre = "Script de nettoyage des fichiers et sous-dossiers by Hackoo 2015"
Dim objFSO,ws,strPath,Temp,Question,LogFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "txt"
if objFSO.FileExists(LogFile) Then 'Si le fichier LogFile existe
objFSO.DeleteFile LogFile 'alors on le supprime
end If
Temp = ws.ExpandEnvironmentStrings("%Temp%")'Dossier temporaire
strPath = Temp
Question = Msgbox("ATTENTION ! "& vbcr &_
"Le script va effacer tous les fichiers et les sous-dossiers du dossier "& vbcr &_
DblQuote(Temp) & vbcr & "Voulez-vous continuer ou non ? ",VbYesNo+VbExclamation,Titre)
If Question = VbNo Then
Wscript.Quit
end if
If Question = VbYes Then
If Not objFSO.FolderExists(strPath) Then
MsgBox "Erreur dans chemin du dossier "& DblQuote(strPath),VbCritical,Titre
Wscript.Quit
End if
Call Cleanup(strPath)
end if
MsgBox "Tous les fichiers et les sous-dossiers du répertoire "& DblQuote(strPath) & Vbcr &_
" ont été supprimés !",Vbinformation,Titre
'*******************************************************************
Sub Cleanup(str)
On Error Resume Next
Dim objFolder,objSubFolder,objFile
Set objFolder = objFSO.GetFolder(str)
For Each objFile In objFolder.Files
objFile.Delete(True)
If Err <> 0 Then
Call WriteLog(DblQuote(objFile) & " ===> "& Err.Description,LogFile)
End if
Next
'Traitement des sous-dossiers
For Each objSubFolder In objFolder.SubFolders
Cleanup(objSubFolder.Path)' appel récursive dans la même fonction
'Les fichiers ont été supprimés,on vérifie si le dossier est vide alors,on le supprime.
If (objSubFolder.Files.Count = 0) Then
objSubFolder.Delete(True)
End If
Next
End Sub
'******************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'******************************************************************
'Fonction pour écrire le résultat dans un fichier texte
Sub WriteLog(strText,LogFile)
Dim fs,ts
Const ForAppending = 8
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(LogFile,ForAppending,True)
ts.WriteLine strText
ts.Close
End Sub
'*****************************************************************
Dim oFolder, oShell Dim Chemin Set oShell = CreateObject("Shell.Application") Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", RETURNONLYFSDIRS, "c:\") If oFolder is Nothing Then MsgBox "Abandon opérateur",vbCritical Else Set oFolderItem = oFolder.Self Chemin=oFolderItem.path MsgBox Chemin & "\" End If
16 déc. 2017 à 12:09
Pourquoi ne pas récupérer les variables TMP et TEMP de l'utilisateur et du système ?
Cordialement
20 févr. 2020 à 16:38