' Delete_Recursively.vbs ' 11:08 PM 9/11/2007 ' Adam Timperley ' ' Deletes files & subfolders Dim FSO, sFil, arg, s, sPath, fldrPath Set FSO = CreateObject("Scripting.FileSystemObject") Set WshShell = CreateObject("WScript.Shell") On Error Resume Next 'Get the folder to work with If WScript.Arguments.Count = 0 Then WScript.Quit ElseIf WScript.Arguments.Count > 0 Then sPath = WScript.Arguments.Item(0) 'Retrieve path to folder fldrPath=fso.GetAbsolutePathName(sPath) '--Call the Function to Delete Files s = DoDelete(fldrPath) End If Set FSO = nothing Set WshShell = nothing Function DoDelete(FolPath) Dim SubPath, Fol, s1, sList, oFol, Fils, oFil, s, sPath, Fols Set objFolder = FSO.GetFolder(FolPath) Set colFiles = objFolder.Files If colFiles.count > 0 Then For Each objFile in colFiles objFile.Delete Next ErrorCheck () End If Set Fols = objFolder.SubFolders If Fols.count > 0 Then For Each Fol in Fols SubPath = Fol.Path s1 = DoDelete(SubPath) Call DeleteEmptyFolders(SubPath) Next ErrorCheck () End If Set Fols = Nothing Set Fils = Nothing Set oFol = Nothing DoSearch = sList End Function 'Deletes Folders Function DeleteEmptyFolders(strFolderPath) 'Public Sub DeleteEmptyFolders(ByVal strFolderPath As String) FSO.DeleteFolder(strFolderPath) End Function 'Function for error checking. Function ErrorCheck() If Err.Number <> 0 Then WshShell.LogEvent 1, "Script encountered error. Error number: " & Err.Number & _ ". Error description: " & Err.Description WScript.Quit Else WshShell.LogEvent 4, "Script completed successfully." End If End Function