Am sorry that the title is ambiguous but i didn't know how to describe my problem in the title,any way ,i have this part of my long code that triggers a Save dialog:
Line1:
Dim dlgSaveAs As Object
Dim strFilePath As String
Dim strFileName As String
Set dlgSaveAs = Application.FileDialog(2)
With dlgSaveAs
.InitialFileName = (CurrentProject.Path) & "\Folder" & "_" & Format(Date, "yyyy")
End With
dlgSaveAs.Show
strFilePath = dlgSaveAs.SelectedItems(1)
strFileName = Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, "\"))
ActiveWorkbook.SaveAs FileName:=CurrentProject.Path & "\" & strFileName, FileFormat:=xlOpenXMLWorkbook
SaveError:
Select Case Err.Number
Case 1004 'if it's want to overwrite an old file and i clicked "no" or "cancel"
GoTo Line1 'reopen the Save Dialog
Case 5 'if i clicked "cancel" on the Save Dialog
rs1.Close
Set rs1 = Nothing
MsgBox ("Canceled")
Exit Sub
End Select
as i explained in the code,if the ErrorHandler detects an '1004' error it will reopen the Save dialog after it was closed.
Every time, the first time the error '1004' occurs the handler detects it normally,but after reopening the dialog(by the ErrorHandler),the handler stops detecting anything neither '1004' nor '5'.
Why is that ?
Ever heard that?
GOTO IS EVIL
Well, GoTo is evil.
First, stick On Error GoTo SaveError at the top of the procedure - that's what will ensure a proper jump on error.
When error 1004 occurs the first time, VBA enters "error-handling mode", and enters the SaveError subroutine.
There are several ways to get VBA out of "error-handling mode" and back into "normal execution mode" without jumping out of the procedure you're in:
Resume will re-run the statement that caused the error (watch for infinite loops here!)
Resume Next will run the next statement after the one that caused the error
Resume {line label} will jump to the specified label
Notice all of them involve the Resume keyword.
When you say GoTo Line1, you re-run the procedure, but VBA still thinks it's handling an error.
And an error that's raised while the runtime thinks it's handling an error will definitely not do what you expect it to do (as you've noticed).
Replace GoTo Line1 with Resume Line1.
Also consider using Exit Sub or Exit Function before the error-handling subroutine / label, so as to only ever run that chunk of code when you're in an error state.
Lastly, consider using the .Show function's return value to determine if the dialog was cancelled, instead of relying on runtime errors.
Related
I've created a Macro based on a blog post that only successfully runs in the VBA editor. When I run it from Outlook itself, nothing happens. Maybe you can see something obvious that I'm missing.
Pressed Alt+F11 to open the editor.
Named the module and pasted in the code.
Compiled and run. The e-mail in question opened in HTML-format as expected.
Closed the editor and added the button to the toolbar I wanted. Nothing happens.
Returned to the VBA editor and run the code. It works as expected.
Closed and re-opened Outlook to try the button again. Nothing happens.
Here's the code, with a screenshot of the code in the editor to follow.
Sub ReplyInHtmlFormat()
Dim olSel As Selection
Dim oMail As MailItem
Dim oReply As MailItem
Set olSel = Application.ActiveExplorer.Selection
Set oMail = olSel.Item(1)
If oMail.BodyFormat = olFormatPlain Or olFormatRichText Or olFormatUnspecified Then
oMail.BodyFormat = olFormatHTML
oMail.Save
End If
Set oReply = oMail.Reply
oReply.Display
Set olSel = Nothing
Set oMail = Nothing
Set oReply = Nothing
End Sub
You may want to check the macro permissions to make sure it is allowed to run. I hope that helps! ;-)
Try to add MsgBox statement outside of any If statement and you will be able to understand whether it is actually running or not when you click a button added to the toolbar.
Also, I'd recommend adding an error-handling routine to the function:
Public Sub OnErrorDemo()
On Error GoTo ErrorHandler ' Enable error-handling routine.
Dim x, y, z As Integer
x = 50
y = 0
z = x / y ' Divide by ZERO Error Raises
ErrorHandler: ' Error-handling routine.
Select Case Err.Number ' Evaluate error number.
Case 10 ' Divide by zero error
MsgBox ("You attempted to divide by zero!")
Case Else
MsgBox "UNKNOWN ERROR - Error# " & Err.Number & " : " & Err.Description
End Select
Resume Next
End Sub
So, you will be aware of any issues if any.
I have excel vba code that opens different files on makes use of them. An error can occur because there is no file where excel loos for it. I want to create a MsgBox on such errors with a message which specific file is absent.
Now I can only
On Error GoTo ErrorHandler
ErrorHandler:
MsgBox("File is absent")
But I can't specify which exactly file is absent. Is there a way to achieve it through error handler? Maybe through some additional variable?
EDIT: I open files through
Workbooks.Open Filename:=...
But I'm curious about what one should do if the case is
Dim fileTitle As String
filetitle=Dir()
as well.
Rather than hard-coding the file path via:
Workbooks.Open Filename:=...
Use a variable to represent the file path/name:
Dim fileName As String
fileName = "C:/path/to/my/file.xlsx"
Then, check to make sure it exists before you attempt to open it:
If FileIsAccessible(fileName) Then
' Do stuff
Else
MsgBox fileName & " doesn't exist or cannot be opened"
Exit Sub
End If
Use a custom function like
Function FileIsAccessible(path$) As Boolean
Dim FF As Long
On Error GoTo EarlyExit
FF = FreeFile
'Does file exist?
' Raises Error 53 if file not found
Open path For Input Access Read As FF
Close FF
'If file exist, is it accessible?
' Raises error 70 if file is locked/in-use
FF = FreeFile
Open path For Binary Access Write As FF
Close FF
EarlyExit:
FileIsAccessible = (Err.Number = 0)
End Function
You still have access to your variables in error handler, so you know within which file error happen:
Sub ...
Dim filename As String
On Error GoTo ErrorHandler
filename = Dir(...)
While filename>""
Set wb = Workbooks.Open(filename)
...
filename=Dir
Wend
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & " File: " & filename
End Sub
Two ways to go about this. First, as you suggested, (which is also the easier of the two), you can make a variable that will carry the file name that you reassign after each file successfully loads. That name can then be passed into your message box in the event of a failure. If all you need to do is pass this name, this is the better solution.
The second option would be to create multiple error handlers. I would only recommend this if you need more customization with regard to how the error is handled, like wanting a different message to be displayed based on which type of file was missing. This option would make your code a good bit messier (as you would need to reassign the On Error GoTo ... statement multiple times, but its worth considering if you need a more complex solution.
Give this a try and tweak it as per your requirement. This will give you a starting point to deal with error handling....
Assuming you are trying to open a file abc.xlsx which is located at your Desktop and if this file isn't found on Desktop, the error handling will be triggered.
Don't forget to use Exit Sub before Error Handling label so that it is not executed if the file was found.
Dim wb As Workbook
Dim FilePath As String
FilePath = Environ("UserProfile") & "\Desktop\abc.xlsx"
On Error GoTo ErrorHandler
Set wb = Workbooks.Open(FilePath)
'Other stuff here if file was found and opened successfully
'
'
'
'
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbNewLine & Err.Description, vbCritical, "File Not Found!"
Why does this not suppress errors?
For i = 1 To Last_row
On Error GoTo errorhandler1
Set wkb = Workbooks.Open(Filename:=l)
'' my code
errorhandler1:
next I
This is what I get:
Before we begin, your code is not set up properly for error handling.
I found that once the GoTo errohandler1 had been executed in the first instance, future calls were ignored so that's when the errors were thrown.
You current code is set up to ignore errors when opening workbooks, you can achieve this using Resume Next, and then GoTo 0 to reset the error handling method.
For i = 1 To Last_row
On Error Resume Next
Set wkb = Workbooks.Open(Filename:=l)
On Error GoTo 0
If Not wkb Is Nothing Then
'' my code
End If
next I
If you want to actually deal with errors -- rather than ignore them, you should do so outside of your loop (strongly encouraged!)
For i = 1 To Last_row
On Error GoTo CleanFail
Set wkb = Workbooks.Open(Filename:=l)
'' my code
next I
Exit Sub
CleanFail:
'deal with error
On Error GoTo is more than just some kind of conditional GoTo jump.
When the runtime encounters an error, it is in an error state that you need to clear up.
An error-handling subroutine isn't just a label code jumps to in case of error - it's where you handle runtime errors.
By jumping to the Next statement you make that next iteration occur in a runtime error state, because you didn't Clear the error state ...so execution resumes and all the while, as far as VBA runtime is concerned, the loop body itself becomes the error-handling subroutine: VBA is waiting for Err.Clear, or Resume Next, or any other statement that tells it "all good, error is handled, move along, nothing to see here".
errorhandler1:
Err.Clear
On Error GoTo 0
next i
That would fix the immediate problem, but still leave you with a quite convoluted spaghettish piece of code. Best extract the error-handling clean out of the "happy path".
Not sure why you can't bypass a file not found error...
Try using a sub function to return the open file (if found) instead?
Function GetWorkBook(ByVal sFullName As String, Optional ReadOnly As Boolean) As Workbook
Dim sFile As String: sFile = Dir(sFullName)
On Error Resume Next
Set GetWorkBook = Workbooks(sFile)
If GetWorkBook Is Nothing Then Set GetWorkBook = Workbooks.Open(sFullName, ReadOnly:=ReadOnly)
End Function
I use MZ Tools for Excel VBA at work, and I use their automatic error handler feature for most of my procedures because it allows me to easily put my contact information in the error message and automatically turn display alerts and screen updating back on. But if an error handler is used in VBA, it becomes difficult to locate the exact line of code that triggered the error, especially in a longish procedure. The default the only way I could figure out to use a custom error handler and get the line of code that triggered the error was to add these two lines to the end of the error handler (so that the problem line would be re-run with the default error handler after the custom error handler had done its work):
On Error GoTo 0
Resume
This works well if there is only one error handler; the user needs to click through one additional dialog box, but I can debug normally while maintaining the functionality built into my custom error handlers. But if both the calling routine and subroutine have distinct error handlers, the user starts to get a lengthy cascade of similar-looking dialog boxes. Precisely, I get 1 + n! dialogue boxes, where n is the number of levels of subroutines with error handlers.
The simplest way to illustrate the issue is when I run the first routine, I get 4 error messages instead of just 2:
Sub TstErrHndlr()
On Error GoTo TstErrHndlr_Error1
Call TstErrHndlrA
On Error GoTo 0
Exit Sub
TstErrHndlr_Error1:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Call MsgBox("Error " & Err.Number & " (" & Err.Description _
& ") in procedure TstErrHndlr " _
& "of Module Create_Package." _
& " Contact [My Name] for assistance " _
& "(myemal#company.com, (123)456-7890)")
On Error GoTo 0
Resume
End Sub
Sub TstErrHndlrA()
On Error GoTo TstErrHndlrA_Error1
Dim X As Double
X = 1 / 0
On Error GoTo 0
Exit Sub
TstErrHndlrA_Error1:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Call MsgBox("Error " & Err.Number & " (" & Err.Description _
& ") in procedure TstErrHndlrA " _
& "of Module Create_Package." _
& " Contact [My Name] for assistance " _
& "(myemal#company.com, (123)456-7890")
On Error GoTo 0
Resume
End Sub
After going through the code in debug mode, it seems like whenever a procedure is called by another procedure, whichever error handler was enabled in the calling function becomes the error handler that is enabled by the line On Error GoTo 0 no matter how many times it is repeated. I would like to know why VBA behaves this way, how to make it not behave this way, and/or if there is a better way to accomplish my goal of getting the line of code that triggered an error while using an error handler. I know that I could revert to the default error handler before a function is called with a new error handler (eg, On Error GoTo 0: Call TstErrHndlrA, but this makes for ugly confusing code, and will not handle errors that occur in the function call.
I suggest a restructure of your error handlers as follows
Add a Debug mode for your own use, which breaks in the error handler and offers possibility of a resume to see the line causing the error
Only raise the error popup at the level causing the actual error
Reset Application properties at the top level only
Lower level routine calls pass up unhandled errors
.
Option Explicit
' Debug Mode Flag (or you could use Conditional Compilation)
' Set to TRUE for developer mode debugging
Const DebugMode As Boolean = False ' True
Sub TstErrHndlr()
On Error GoTo TstErrHndlr_Error1
TstErrHndlrA
Exit Sub
TstErrHndlr_Error1:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
' display message if error is raised in this module
If Err.Source = Application.VBE.ActiveVBProject.Name Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & vbLf & _
"in procedure TstErrHndlr" & vbLf & _
"Contact [My Name] for assistance " & _
"(myemal#company.com, (123)456-7890)"
End If
' Break in Debug mode
If DebugMode Then
Debug.Assert False
Resume
End If
End Sub
Sub TstErrHndlrA()
On Error GoTo TstErrHndlrA_Error1
Dim X As Double
X = 1 / 0
Exit Sub
TstErrHndlrA_Error1:
' These should be handled at top level for unhandled errors only
' Application.Calculation = xlCalculationAutomatic
' Application.ScreenUpdating = True
' Application.DisplayAlerts = True
' display message if error is raised in this module
If Err.Source = Application.VBE.ActiveVBProject.Name Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & vbLf & _
"in procedure TstErrHndlrA" & vbLf & _
"Contact [My Name] for assistance " & _
"(myemal#company.com, (123)456-7890)"
End If
' Break in Debug mode
If DebugMode Then
Debug.Assert False
Resume
End If
' Pass unhandled errors up the tree
Err.Raise Err.Number, "TstErrHndlrA", Err.Description
End Sub
With Debug Mode OFF the user gets one popup identifying the error and routine it occurs in
With Debug Mode ON you also get a break in the routine causing the error, and the possibility of a Resume to the line causing the error. (Or use Ctrl-F9 to step over the Resume)
From MSDN's On Error page:
An "enabled" error handler is one that is turned on by an On Error statement;
an "active" error handler is an enabled handler that is in the process
of handling an error. If an error occurs while an error handler is
active (between the occurrence of the error and a Resume, Exit Sub,
Exit Function, or Exit Property statement), the current procedure's
error handler can't handle the error. Control returns to the calling
procedure. If the calling procedure has an enabled error handler, it
is activated to handle the error. If the calling procedure's error
handler is also active, control passes back through previous calling
procedures until an enabled, but inactive, error handler is found. If
no inactive, enabled error handler is found, the error is fatal at the
point at which it actually occurred. Each time the error handler
passes control back to a calling procedure, that procedure becomes the
current procedure. Once an error is handled by an error handler in any
procedure, execution resumes in the current procedure at the point
designated by the Resume statement.
So to answer "Why does VBA behave this way": Because that's the way they made it.
To make it not behave this way, you will have to (as you mentioned) disable the current error handler with before calling the sub/function.
Using ERL as #Rory mentioned will get you the exact line where your code fails, and you might possibly be able to utilize On Error Goto -1 in a broadly generic error trapping routine. It really comes down to being careful about calling other subs/functions, or having functions which can return an error code as their value (ie, bubbling the error up manually). For example, here's a function that returns the error as the value of the function rather than attempting to raise any kind of exception during the function call. You may also notice that some of the functions it calls might return errors as well.
Public Function SetTask(ByVal strHost As String, strUser As String, strDomain as String, strPass As String) As String
Dim service As Object
Dim rootFolder As Object
Dim taskDefinition As Object
Dim strCMD As String
Dim strResult As String
On Error GoTo TaskNotSet
SetTask = "Task Not Set"
'Open the firewall
strResult = OpenFirewall (strHost)
If strResult <> "Ok" Then
SetTask = "Error Opening Firewall (" & err.Number & ") " & err.Description
Exit Function
End If
Set service = CreateObject("Schedule.Service")
service.Connect strHost, strUser, strDomain, strPass
Set rootFolder = service.GetFolder("\")
Set taskDefinition = service.newtask(0)
taskDefinition.XmlText = TaskXML
Call rootFolder.RegisterTaskDefinition("Weekly VMC Inventory", taskDefinition, 6, , , 3)
'Close the firewall
strResult = CloseFirewall (strHost)
If strResult <> "Ok" Then
SetTask = "Error Closing Firewall (" & err.Number & ") " & err.Description
Exit Function
End If
SetTask = "Task Set"
Set taskDefinition = Nothing
Set rootFolder = Nothing
Set service = Nothing
Exit Function
TaskNotSet:
CloseFirewall (strHost)
SetTask = "Error Setting Task (" & err.Number & ") " & err.Description
Set taskDefinition = Nothing
Set rootFolder = Nothing
Set service = Nothing
End Function
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.