Error Handling in file search

[Babscoole]

Having a problem with a script I've been working on. I thought it was functionaly complete and rolled it out to the end user that needed it, but the user ran into a situation today that I'd like to get fixed. It just needs a bit of error checking, but I'm not sure where to roll it in. The problem is in the recursive search for a "source" file. If the script can't find the file specified, it just quits. I need it to throw a message along the lines that the file couldn't be found. Script pasted below:

dtmStart = Now()
strCaseFile = InputBox("Enter the case number for the file to unpurge:" & Chr(13) & "(This may take several minutes. You will be prompted upon completion)","WLF Archive File UnPurge Tool", "Enter 6 digit Case number here") & ".tif"
strCaseDb = Left(strCaseFile,6)
If strCaseFile = "" Then
WScript.Quit
Else
' WScript.Echo strCaseFile
End If

Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Width=600
objExplorer.Height = 200
objExplorer.Left = 0
objExplorer.Top = 0
objExplorer.Document.Title = "WLF Case UnPurge Tool"

Do While (objExplorer.Busy)
WScript.Sleep 200
Loop

objExplorer.Visible = 1
objExplorer.Document.Body.bgcolor = "green"

Call DBUpdate
Call folderlist("\\sup02\archive", strCaseFile, "\\wlf-dc1\CaseLib")
WScript.Quit


Sub folderlist(searchFolder,toFind, destDir)

objExplorer.Document.Body.InnerHTML = "Finding File In Archive. " _
& "This may take several minutes to complete."

On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")

Dim myFolder,Subfolder,mySubfolders, File, tmpFileName

If (Right(searchFolder,1) <> "\") Then
searchFolder = searchFolder & "\"
End If

Set myFolder = fso.GetFolder(searchFolder)
Set mySubFolders = myFolder.SubFolders

For Each File In MyFolder.Files 'Loop through the files in the folder
'WScript.Echo ("File: '" & File.Name & "'")
toFind = LCase(toFind)
tmpFileName = LCase(File.Name)
If (tmpFileName = toFind) Then

' WScript.Echo (Left(file.path, Len(file.path) - Len(file.name) ) )
' WScript.Echo (File.Size & " bytes" & vbtab & File.Type & vbtab & File.DateCreated & vbtab & File.name )

If (Right(destDir,1) <> "\") Then
destDir = destDir & "\"
End If

If fso.FileExists(destDir & file.name) Then
' WScript.Echo destDir & file.name & " already exists in CaseLib."
MsgBox destDir & file.name & " already exists.", 0
WScript.Quit
Else
'WScript.Echo ("fso.CopyFile " & File.path & ", " & destDir)
fso.CopyFile File.path, destDir, True
Set objShell = CreateObject("Wscript.Shell")
objShell.Run "Attrib.exe +r " & destDir & "\" & file.name, 0, True
dtmEnd = Now()
MsgBox file.name & " has been restored to CaseLib." & " Operation completed in " & DateDiff("s", dtmStart, dtmEnd) & " seconds.", 0
' objExplorer.Document.Body.InnerHTML = file.name & " has been restored to CaseLib." & " Operation completed in " & DateDiff("s", dtmStart, dtmEnd) & " seconds."
objExplorer.Quit


End If

If (Err.Number <> 0) Then
MsgBox "Error: " & Err.Number & vbcrlf & Err.Description & vbcrlf & Err.Source
End If
End If
Next

For Each Subfolder In myFolder.SubFolders

Call folderlist(Subfolder.path, toFind, destDir)
Next
End Sub

Sub DBUpdate

objExplorer.Document.Body.InnerHTML = "Restoring Entry in CaseFile Database. " _
& "This may take several minutes to complete."
WScript.Sleep 5000

Dim oConn

Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=\\wlf-dc1\CaseDatabase\Case_Files.mdb"

' execute query. Must have space after Procedure Name
oConn.Execute "exec RetPurgProc " & strCaseDB


' Clean up
oConn.Close
' oConn.Quit
Set oConn = Nothing

objExplorer.Document.Body.InnerHTML = "Case File " & strCaseDB & " has been restored to the CaseFile database. It will be usable in Caseweb after the next Day-End run"
WScript.Sleep 5000

End Sub

 

[mrmovie]

well, your code makes it difficult to suggest an elegant answer, this is due to your use of Explorer.Quit? but i guess you ahve it commented but perhaps just for debugging? anyway, i would advise you not to do this, have the sub complete and then quit in your main body, otherwise you end up with lots of quits all over the place and it becomes hard to read and code.

but to answer you question....one way would be a function rather than a sub? (or perhaps a sub which you pass a param you update)

using the Function in this way also has the effect of seperating your computation from your GUI code....another good practice i would say

blnFound = False
blnFound = x("hello")
If blnFound = True Then
'now display stuff
Else
'now display stuff
End If

Function x(strParam)

For Each aFile In MyFolder.Files
If I Find My File Then
x = True
Exit Function 'still yuk
End If
Next

For Each aFolder In SubFolders

Next
End Sub

 

[Babscoole]

Thanks for the response mrmovie.

I tried putting explorer.quit into the main, but for whatever reason, it wasn't closing the IE display window. I'm using IE to give feedback to the end-user that the script is running, since the file search could take up to 10 minutes.

Probably would be better, separating it out like that, but I had alot of assistance with the current recursive search and correlating your suggested code with what already exists is over my head I'm afraid. I was just hoping that there would be a line or two I could add.

The commented WScript.Echo stuff is there for debugging purposes. I pulled out the "user display" stuff and the other sub to make it easier to read. Sorry about that:

strCaseFile = InputBox("Enter the case number for the file to unpurge:" & Chr(13) & "(This may take several minutes. You will be prompted upon completion)","WLF Archive File UnPurge Tool", "Enter 6 digit Case number here") & ".tif"

If strCaseFile = "" Then
WScript.Quit
Else
' WScript.Echo strCaseFile
End If

Call folderlist("\\sup02\archive", strCaseFile, "\\wlf-dc1\CaseLib")
WScript.Quit


Sub folderlist(searchFolder,toFind, destDir)

On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")

Dim myFolder,Subfolder,mySubfolders, File, tmpFileName

If (Right(searchFolder,1) <> "\") Then
searchFolder = searchFolder & "\"
End If

Set myFolder = fso.GetFolder(searchFolder)
Set mySubFolders = myFolder.SubFolders

For Each File In MyFolder.Files 'Loop through the files in the folder
'WScript.Echo ("File: '" & File.Name & "'")
toFind = LCase(toFind)
tmpFileName = LCase(File.Name)
If (tmpFileName = toFind) Then

' WScript.Echo (Left(file.path, Len(file.path) - Len(file.name) ) )
' WScript.Echo (File.Size & " bytes" & vbtab & File.Type & vbtab & File.DateCreated & vbtab & File.name )

If (Right(destDir,1) <> "\") Then
destDir = destDir & "\"
End If

If fso.FileExists(destDir & file.name) Then
' WScript.Echo destDir & file.name & " already exists in CaseLib."
MsgBox destDir & file.name & " already exists.", 0
WScript.Quit
Else
'WScript.Echo ("fso.CopyFile " & File.path & ", " & destDir)
fso.CopyFile File.path, destDir, True
Set objShell = CreateObject("Wscript.Shell")
objShell.Run "Attrib.exe +r " & destDir & "\" & file.name, 0, True

MsgBox file.name & " has been restored to CaseLib." 0


End If

If (Err.Number <> 0) Then
MsgBox "Error: " & Err.Number & vbcrlf & Err.Description & vbcrlf & Err.Source
End If
End If
Next

For Each Subfolder In myFolder.SubFolders

Call folderlist(Subfolder.path, toFind, destDir)
Next
End Sub

 

[mrmovie]

its makes it difficult because you are recursing, you cant have a something that determines that it hasnt been successful unless you want to do something really really messy

dont have your FSO creation in teh function, it will get crated and destroyed every iteration and will kill your speed

does the below work?

Set fso = CreateObject("Scripting.FileSystemObject")
blnFound = False
blnFound = folderlist("\\sup02\archive", strCaseFile, "\\wlf-dc1\CaseLib")
Msgbox blnFound

Function folderlist(searchFolder,toFind, destDir)

'On Error Resume Next



Dim myFolder,Subfolder,mySubfolders, File, tmpFileName

If (Right(searchFolder,1) <> "\") Then
searchFolder = searchFolder & "\"
End If

Set myFolder = fso.GetFolder(searchFolder)
Set mySubFolders = myFolder.SubFolders

For Each File In MyFolder.Files 'Loop through the files in the folder
'WScript.Echo ("File: '" & File.Name & "'")
toFind = LCase(toFind)
tmpFileName = LCase(File.Name)
If (tmpFileName = toFind) Then

' WScript.Echo (Left(file.path, Len(file.path) - Len(file.name) ) )
' WScript.Echo (File.Size & " bytes" & vbtab & File.Type & vbtab & File.DateCreated & vbtab & File.name )

If (Right(destDir,1) <> "\") Then
destDir = destDir & "\"
End If

If fso.FileExists(destDir & file.name) Then
' WScript.Echo destDir & file.name & " already exists in CaseLib."
MsgBox destDir & file.name & " already exists.", 0
folderlist = True
Exit Sub
Else
'WScript.Echo ("fso.CopyFile " & File.path & ", " & destDir)
fso.CopyFile File.path, destDir, True
Set objShell = CreateObject("Wscript.Shell")
objShell.Run "Attrib.exe +r " & destDir & "\" & file.name, 0, True

MsgBox file.name & " has been restored to CaseLib." 0


End If

If (Err.Number <> 0) Then
MsgBox "Error: " & Err.Number & vbcrlf & Err.Description & vbcrlf & Err.Source
End If
End If
Next

For Each Subfolder In myFolder.SubFolders

Call folderlist(Subfolder.path, toFind, destDir)
Next
End Function

 

[Babscoole]

Update.

Unfortunately it didn't work, but I found another recursive search funtion, similar to yours, that I'm attempting to modify to suit my purpose. I'll post back when/if I get it running.

 

[Babscoole]

OK, still have to add back in the user feedback stuff and the database stuff, but here is what is now working:

dtmStart = Now()
strCaseFile = InputBox("Enter the case number for the file to unpurge:" & Chr(13) & "(This may take several minutes. You will be prompted upon completion)","WLF Archive File UnPurge Tool", "Enter 6 digit Case number here") & ".tif"

Set objShell = CreateObject("Wscript.Shell")
destDir = "L:\"

If strCaseFile = "" Then
WScript.Quit
Else
' WScript.Echo strCaseFile
End If

If findfile( "s:\FileBack", strCaseFile, file) Then
file.Copy destDir
objShell.Run "Attrib.exe +r " & destDir & file.name, 0, True
dtmEnd = Now()
MsgBox file.name & " has been restored to CaseLib." & " Operation completed in " & DateDiff("s", dtmStart, dtmEnd) & " seconds.", 0
Else
MsgBox strCaseFile & " Does not exist in the Archive." & " Operation completed in " & DateDiff("s", dtmStart, dtmEnd) & " seconds.", 0
End If

Function findfile ( searchFolder, FileToFind, ofile)
Set fso = CreateObject("Scripting.FileSystemObject")
Set folders = fso.GetFolder(searchFolder)
For Each file In folders.Files
If UCase(file.Name) = UCase(FileToFind) Then
bFound = True
Set ofile = file
FindFile = True
Exit Function
End If
Next

For Each folder In folders.SubFolders
If findfile( folder.Path, FileToFind, ifile) Then
Set oFile = ifile
findfile = True
Exit Function
End If
Next
End Function

 

[mrmovie]

yeah, i thought you would need to exit in the folder recursion as well

 

[Babscoole]

Everything don't now except for one thing, need to add back in one check:

If fso.FileExists(destDir & file.name) Then
MsgBox destDir & file.name & " already exists.", 0
WScript.Quit

I think that I just need to do something like this:

If findfile( "s:\FileBack", strCaseFile, file) Then
If fso.FileExists(destDir & file.name) Then
MsgBox destDir & file.name & " already exists.", 0
WScript.Quit
Else
file.Copy destDir

Does this seem right, and will I have to add another end if and where if necessary? Thanks.

 

[dm4ever]

Since it looks like your findfile returns a true/false, then you should just need:

If findfile(arguments) Then
'file was found so do something
Else
'file was not found so do something else
End If

--------------------------------------------------------------------------------
dm4ever
My philosophy: K.I.S.S - Keep It Simple Stupid

 

[Babscoole]

This check is looking for if the file already exists at the destination point, a separate check from if the source file even exists. If it does, then the script should end and not even bother trying to do the copy operation.I wouldn't think it would be necessary to have the script do a completely separate search, since there are no subdirectories to look through in the destination directory. L:\file.Name will either be there or it won't. I think that I just figured this out myself. It should do the check first even before "If findfile( "s:\FileBack", strCaseFile, file) Then", no point in even searching the source if it's not going to copy anything over anyway.