There is some old legacy vbscript code we have that needs some sort of error handing in it. Having never used vbscript before, I'm at a total loss. Here is the code:
set objBL = CreateObject("SQLXMLBulkLoad.SQLXMLBulkload.4.0")
objBL.ConnectionString = "connectionstring"
objBL.KeepIdentity = false
objBL.ErrorLogFile = "E:\code\Acquity\WebOrderImport\logs\error.log"
Set fso = CreateObject("Scripting.FileSystemObject")
Set parentfolder = fso.GetFolder("E:\textdata\Acquity\AcquityWebOrders")
Set logfile = fso.OpenTextFile("E:\code\Acquity\WebOrderImport\logs\import.log",8)
count = 0
For each folder in parentfolder.subfolders
logfile.writeline count & " files"
logfile.writeline "Processing " & folder.name & " ***********************************" & now()
count = 1
For Each file in folder.files
If left(file.name,6) = "Order_" then
If left(file.name,13) = previous then
logfile.writeline "!!!!! SKIPPING file " & file.name & "!!!!! DUPED ORDER ID"
Else
logfile.writeline "reading " & file.name
objBL.Execute "E:\code\Acquity\WebOrderImport\acq_WebOrder_import.xsd", file.path
count=count+1
End If
previous = left(file.name,13)
End If
Next
Next
set objBL=Nothing
logfile.writeline "Done!"
Set logfile = nothing
Set parentfolder = nothing
set fso = nothing
I'm pretty sure this line:
bjBL.Execute "E:\code\Acquity\WebOrderImport\acq_WebOrder_import.xsd", file.path
keeps throwing exceptions, and I need the code to keep running when it hits an error, rather than stopping. How can I do this?
To ignore errors, add On Error Resume Next before the part that can cause them. To disable the effect of "resume next", use On Error Goto 0.
For a quick and (very) dirty way to get the code to keep running, you can add On Error Resume Next to the top of the file, and execution will happily carry on when it hits an error.
I have a little practice with this technology, but AFAIK vbscript has only one way to handle runtime-exceptions: On Error Resume Next.
You can read these articles: MSDN article and more helpful for me about handling and notifying.
Related
..................................................................................................................................................................
Late-breaking news...
P.P.S. I just read that FileSystem.FileCopy is better than just FileCopy. That's what I'm going to try. But I really would like to know how to use FileCopy inside a loop, meaning, "How do I close files used in FileCopy?" For the big picture made clear, read on.
..................................................................................................................................................................
(Using Windows 10 Pro, Word 365 Pro)
The online Help for FileCopy Src, Dest says that it ... Copies a file from Src to Dest [but] does not work on a currently open file. Both ... files must be closed [by] the Close statement.
But the online help for Close, from link supplied on that page connects to help for Close for the Open statement, which says that it "Closes the file(s) previously opened with the" Open statement, not the FileCopy statement.
So it is that I'm stumped on what to do with this code, which will copy the first code module in the Document to a backup location, but not the second.
Pic#1: Info about what's supposedly going to be copied
Pic#2: Original error message without On Error
(I have no clue why all these blank lines. They're NOT in my Body.)
Please ignore all the OnError stuff for now.
When the second code module should have been copied, execution halted with error "File not found".
Sub BackupModules()
Dim prj As VBProject
Dim comp As VBComponent
Dim code As CodeModule
Set prj = ThisDocument.VBProject
Dim k As Integer, n As Integer
Dim Destination As String, Prefix As String
Prefix = "junk"
k = 0: n = 0
On Error GoTo x
For Each comp In prj.VBComponents
On Error GoTo x
k = k + 1
If comp.Type = vbext_ct_StdModule Then
n = n + 1
Destination = Prefix & n
MsgBox "Copying Standard module " & n & " of " & k & " components encountered: <" & comp.Name & "> to " _
& Destination & "; # lines: " & comp.CodeModule.CountOfLines
On Error GoTo x
FileCopy comp.Name, Destination
MsgBox "Success"
Close
Else
x: If Err.Number <> 0 Then: _
msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description: _
MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext: On Error GoTo 0: Close:
End If
Next
End Sub
Then I began experimenting (a LOT as you can see) with On Error Goto x being placed at various places (one at a time and then all, as shown) and the nasty-looking but syntactically and logically correct line that starts x: If Err... placed inside the Else block.
Pic#3: Error msg after using On Error
(FWIW, I just spotted Normal in the Err.Source part of the error message above. Online help says, "When an unexpected error occurs in your code, the Source property is automatically filled in. For errors in a standard module, Source contains the project name. For errors in a class module, Source contains a name with the project.class form." Indeed, the code is in a Module within the Normal Project.)
Pic#4: Line causing error that On Error did NOT trap
So what's wrong? I've tried everything I can think of. The only help I could find for Close did NOT mention its use with FileCopy. My Close usages caused no error but did Close close both the source and the destination file? Surely not. First use of FileCopy worked, files (probably) not closed, thus second use of FileCopy failed. Docs say using FileCopy on an open file will cause error.
On Error Goto x or to 0 is neither here nor there. That's why I said to ignore them at first.
The question is apparently "How do I close both files mentioned in FileCopy?"
P.S. Per opening blurb, I'm NOT gonna do this.
I suppose I could use Open ... For Input As File#1 and specify the Module's name, if it's readily available to code, and also Open ... For Output As File#2 for the destination, use a For loop to copy the number of lines, if available, and then Close both. But I hope I get a solution to my problem before I try that since SURELY FileCopy should work within a loop (and doesn't because of improper close).
Thanks to #TimWilliams, who tipped me off to Export, my final "Backup all modules" routine is quite simple.
Sub BackupModules()
Dim comp As VBComponent
Dim prj As VBProject: Set prj = ThisDocument.VBProject
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
Dim destPrefix As String: destPrefix = "C:\Users\Dov\Google Drive\Word\Modules\"
Dim destFilePath As String
For Each comp In prj.VBComponents
If comp.Type = vbext_ct_StdModule Then
destFilePath = destPrefix & comp.Name & " " & Year(Now) & " " & Month(Now) & " " & Day(Now)
Debug.Print "Copying Standard module <" & comp.Name & "> to <" & destFilePath & ">"
comp.Export (destFilePath)
Else
Debug.Print "Skipping component # " & k & ", <" & comp.Name & ">, type " & comp.Type
End If
Next
End Sub
I'm trying to diagnose an issue with VBScript FileSystemObject.CopyFile, it's reporting Error 53: File Not Found, but it has successfully copied the file! I've tried variations of the CopyFile command, with full destination name or just folder etc no difference, it always copies the file.
Worse, if I purposefully break it, by changing the source file name, I still get Error 53, which is the exact situation I'm trying to catch and report.
On Error Resume Next
'copy the officeUI xml to the Microsoft Office folder
filePath = profilePath & "\Microsoft\Office\"
if not WshFSO.FolderExists(filePath) then
WshFSO.CreateFolder filePath
end if
WshFSO.CopyFile scriptPath & "\Access.officeUI", filePath, True
'copy the foo client zip to \foo
filePath = profilePath & "\foo\"
if not WshFSO.FolderExists(filePath) then
WshFSO.CreateFolder filePath
end if
WshFSO.CopyFile localZip, filePath, True
if Err.Number <> 0 then
'catch that the copy failed
msg = "Failed to copy Foo, please report this to Help Desk." _
& vbCrLf & vbCrLf & "Citrix Server: " & WshNetwork.ComputerName _
& vbCrLf & "Error: " & err.Number & " - " & err.Description
WshShell.Popup msg, , "Foo Launcher", 16
Err.Clear
WScript.Quit
end if
The error is occuring on the final CopyFile call.
The problem was due to the Error handling logic in VBS, it was reporting the error number from an earlier line! The On Error Resume Next allowed the code to continue to run, but subsequent calls, even successful ones, did not overwrite the Err object. So when I did want to check the result, it picked up this previous error.
So from this I think that unless you want If Err.Number... everywhere is that before each 'block' of code you want to error check, clear the Err object first with Err.Clear.
I wish VBScript had On Error Goto like its cousin!
I'm having a problem with my Access VBA macro which for some reason is breaking on those lines with error "Permission Denied [Run-time error 70]:
sOutputFile = CurrentProject.Path & "\Output Files\Recon\" & sDate & " " & sClient & " Cash Recon.xlsx"
sTemplateFile = CurrentProject.Path & "\Temp Files\Template_Listed.xlsx"
If Dir(sOutputFile) <> "" Then Kill sOutputFile
FileCopy sTemplateFile, sOutputFile
What's getting "pointed out" directly is the "Kill sOutputFile" phrase.
It is worth to mention, that I do not have any of the files open, I have full access to the directories, and not long ago (before declaring sOutputFile and sTemplateFile) they've been both cleared.
Any help is much appreciated and I'm willing to share more of my code if needed.
Edit: Also, from time to time, the macro goes to the next line and breaks at the FileCopy instead.
The logic is not quite right in my opinion, please try the following (FileCopy should be inside an If...End If):
sOutputFile = CurrentProject.Path & "\Output Files\Recon\" & sDate & " " &
sClient & " Cash Recon.xlsx"
sTemplateFile = CurrentProject.Path & "\Temp Files\Template_Listed.xlsx"
If FileExists(sOutputFile) Then
Kill sOutputFile
FileCopy sTemplateFile, sOutputFile
End If
And this is the FileExists function:
Public Function FileExists_1(sFileName As String) As Boolean
Dim obj_fso As Object
Set obj_fso = CreateObject("Scripting.FileSystemObject")
FileExists_1 = obj_fso.fileExists(sFileName)
Set obj_fso = Nothing
End Function
What was the issue in my case, was that I previously used the macro, but the full ran failed. After trying to run it again after few adjustments (not related to the code I posted here), the above issue was happening. All just because I had the file still open somewhere in my excel's memory, hence the file couldn't be deleted.
Thanks for all the contributions guys. You're amazing as always!
I was wondering if anyone could help me with a vb6 function that would delete all files within a directory (excluding subdirectories).
One line, using the VB6 statement Kill
Kill "c:\doomed_dir\*.*"
The help topic says "In Microsoft Windows, Kill supports the use of multiple-character (*) and single-character (?) wildcards to specify multiple files".
As an aside - I prefer to avoid the Microsoft Scripting Runtime (including FileSystemObject). In my experience it's occasionally broken on user machines, perhaps because their IT department are paranoid about viruses.
I believe this should work:
Dim oFs As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File
If oFs.FolderExists(FolderSpec) Then
Set oFolder = oFs.GetFolder(FolderSpec)
'caution!
On Error Resume Next
For Each oFile In oFolder.Files
oFile.Delete True 'setting force to true will delete a read-only file
Next
DeleteAllFiles = oFolder.Files.Count = 0
End If
End Function
I haven't tested every scenario but it should work. It should delete every file and if the file is locked or you don't have access you should get Error 70 which is caught and you get an Abort, Retry or Ignore box.
Sub DeleteAllFilesInDir(ByVal pathName As String)
On Error GoTo errorHandler
Dim fileName As String
If Len(pathName) > 0 Then
If Right(pathName, 1) <> "\" Then pathName = pathName & "\"
End If
fileName = Dir(pathName & "*")
While Len(fileName) > 0
Kill pathName & fileName
fileName = Dir()
Wend
Exit Sub
errorHandler:
If Err.Number = 70 Then
Select Case MsgBox("Could not delete " & fileName & ". Permission denied. File may be open by another user or otherwise locked.", vbAbortRetryIgnore, "Unable to Delete File")
Case vbAbort:
Exit Sub
Case vbIgnore:
Resume Next
Case vbRetry:
Resume
End Select
Else
MsgBox "Error deleting file " & fileName & ".", vbOKOnly Or vbCritical, "Error Deleting File"
End If
End Sub
It would seem that the Scripting runtime FileSystemObject's DeleteFile method also supports wildcards as this works for me:
Dim fs As New Scripting.FileSystemObject
fs.Deletefile "C:\Temp\*.jpg", true
This approach has less control than the approach suggested by #Corazu, but may have some utility in certain cases.
I apologize in advance for the newbie question -- most of my VBA experience is in Excel, or Word to Excel. In this case, I am going from Excel to Word. I am trying to capture some data off of some Word forms and store it in an Excel file.
Right now, my code works for the first document in the folder, but after that, it hoses up with an automation error "the server threw an exception" (goo!)
Here is my code:
Dim objWordApp As Object
strCurFileName = Dir(strFilePath)
Set objWordApp = CreateObject("word.application")
objWordApp.Visible = True
Do While strCurFileName <> ""
objWordApp.documents.Open strFilePath & strCurFileName
objWordApp.activedocument.Unprotect password:="testcode"
{EXCEL PROCESSING HERE}
strCurFileName = Dir
objWordApp.activedocument.Close 0
Loop
objWordApp.Quit
Set objWordApp = Nothing
I notice that the code works fine if I quit the app and set the object = nothing within the loop. But the way it is now, it bombs-out on the second file in the folder on the "objWordApp.documents.Open strFilePath & strCurFileName" line.
Can I open and close Word documents in a loop without having to create the object over and over? It's really slow when I do it that way.
Thanks for the help -- I like your way much better. Unfortunately, I get the same result. The program dies the second time through the loop on the line that reads:
Set objWordDoc = objWordApp.Documents.Open(objFile.Path)
The error that I get is:
Run-time Error -2147417851 (80010105)
Automation Error
The server threw an exception.
I tried your code on regular word docs (not the ones I'm processing) and it worked fine. The docs I'm running have form fields and macros -- not sure if that makes a difference. I have set the macro security in Word to both "low" and "very high" to make sure the other macros don't interfere.
I just can't figure it out why it works for the first doc and then not the next. I even cloned the first doc but it made no difference.
Still no luck, though. The only thing I can get to work is if I completely wipe the objects and re-create them every time I want to open a file.
Set objFolder = FSO.GetFolder(strFilePath)
For Each objFile In objFolder.Files
Set objWordApp = CreateObject("word.application")
objWordApp.Visible = True
If Right(objFile.Name, 4) = ".doc" Then
Set objWordDoc = objWordApp.documents.Open(Filename:=objFile.Path, ConfirmConversions:=False, _
ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto)
[Process DOC]
objWordDoc.Close 0, 1
End If
Set objWordDoc = Nothing
objWordApp.Quit
Set objWordApp = Nothing
Next
I'm not sure why that works and why it won't work the other way. If I have to go this route, I can -- it just seems really slow and inefficient. Is this a bad idea?
I changed the Dir to a FileSystemObject (go to Tools\References and add Microsoft Scripting Runtime) and I was able to successfully open multiple files. If you are having problems, please describe the error you see in the debugger. Also, if you need to recurse into subdirectories, you will need to refactor this.
Private mobjWordApp As Word.Application
Sub Test()
ProcessDirectory "PathName"
End Sub
Property Get WordApp() As Word.Application
If mobjWordApp Is Nothing Then
Set mobjWordApp = CreateObject("Word.Application")
mobjWordApp.Visible = True
End If
Set WordApp = mobjWordApp
End Property
Sub CloseWordApp()
If Not (mobjWordApp Is Nothing) Then
On Error Resume Next
mobjWordApp.Quit
Set mobjWordApp = Nothing
End If
End Sub
Function GetWordDocument(FileName As String) As Word.Document
On Error Resume Next
Set GetWordDocument = WordApp.Documents.Open(FileName)
If Err.Number = &H80010105 Then
CloseWordApp
On Error GoTo 0
Set GetWordDocument = WordApp.Documents.Open(FileName)
End If
End Function
Sub ProcessDirectory(PathName As String)
Dim fso As New FileSystemObject
Dim objFile As File
Dim objFolder As Folder
Dim objWordDoc As Object
On Error Goto Err_Handler
Set objFolder = fso.GetFolder(PathName)
For Each objFile In objFolder.Files
If StrComp(Right(objFile.Name, 4), ".doc", vbTextCompare) = 0 Then
Set objWordDoc = GetWordDocument(objFile.Path)
' objWordDoc.Unprotect Password:="testcode" ' Need to check if it has Password?
ProcessDocument objWordDoc
objWordDoc.Close 0, 1
Set objWordDoc = Nothing
End If
Next
Exit_Handler:
CloseWordApp
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
'Resume Next ' or as above
End Sub
Sub ProcessDocument(objWordDoc As Document)
'{EXCEL PROCESSING HERE}'
End Sub
EDIT: I've added some error handling and a little refactoring although there is quite a bit more refactoring that could be done.
There must be something special about the documents you are opening. You might try using different parameters for opening the documents, such as:
Set objWordDoc = objWordApp.Documents.Open( _
FileName:=objFile.Path, ReadOnly:=True)
You may need to add Microsoft Word as a Reference, and if you do that then start using the Word constants (wdDoNotSaveChanges, etc.). Check out the help on Documents.Open and test different parameters.
Also, use the "Set Next Statement" from the Context Menu during debugging and maybe skip the first document and open the second document directly and see if there are issues.
EDIT: I've changed the code to close and reopen Word if you get the automation error you described. You may have to adjust the error numbers, or simply close Word on any error (If Err.Number <> 0 Then ...).
Again, something must be special about your documents (macros, protection, etc.) because this code works on the test cases I have tried. Have you tried manually opening the documents in Word in the same order as the script, updating information similar to your process script, and then closing the documents to see if Word does anything strange?
Closing the Word.Application won't hurt anything, but it will obviously significantly slower.