I have developed a script to look at each drive and list the folders and subfolders (I only need folders). If I run the VBScript using wcript.exe as a .vbs file it allows the logic to process all the drives. But when I run it in Macro Scheduler I get :
Script Control
The script you are executing is taking longer than expected
According to the help file by default there is no time out on a VBScript running inside of a macro scheduler script. Or is that only true if the VBScript is structured in a certain way, and is there examples anywhere to specify what is acceptable to Macro Scheduler ? please advise…
Code: Select all
VBSTART
'Lets locate the drives for this system
DIM objFile, strFile, objFSO
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
Set filesys = CreateObject("Scripting.FileSystemObject")
If Not filesys.FileExists("DriveLst.txt") Then
For Each objDrive in colDrives
if (objDrive.IsReady)then
Set filetxt = filesys.OpenTextFile("DriveLst.txt", 8, True)
filetxt.WriteLine(objDrive.DriveLetter & ":" & "\")
filetxt.Close
else
Set filetxt = filesys.CreateTextFile("BSDrvNotReady.txt", True)
filetxt.WriteLine(objDrive.DriveLetter & ":" & "\" & " " & "drive is not responding - skipping this drive")
filetxt.Close
end if
Next
Else
'file already exists - do nothing
End if
'Now lets read the drives one at a time and process them
strFile = "DriveLst.txt"
Set objFile = objFSO.OpenTextFile(strFile, ForReading)
FldrDrive = objFile.ReadLine
objFile.Close
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = FldrDrive
On Error Resume Next
Set objFolder = objFSO.GetFolder(objStartFolder)
on Error Resume Next
dim filesys, filetxt, subfolder
Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile("FldrManifest.txt", ForAppending, True)
filetxt.WriteLine(objFolder.subfolders )
filetxt.Close
ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
on Error Resume Next
If Err.number <0>ShowSubFolders,result
Log.Write Err.Description, apgSeverityError, Err.Number
Else
end if
Set objFolder = objFSO.GetFolder(Subfolder.Path)
dim filesys, filetxt
Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile("FldrManifest.txt", ForAppending, True)
filetxt.WriteLine(SubFolder)
filetxt.Close
ShowSubFolders Subfolder
Next
End Sub
VBEND
VBrun>ShowSubFolders,result
