I was hoping someone could have a look and tidy this up for me; I have to say error handling is not strong point of mine. I have the code block below and I have been playing around with some error handles but it is not as I really want it.
What I am trying to do is ensure that if at any point there is an error the workbook and excel instance I have opened are closed down gracefully.
I am sure there are much nicer and simpler ways to achieve this than what I have come up with.
Sub QOScode()
On Error GoTo Fail
Dim app As New Excel.Application
app.Visible = False 'Visible is False by default, so this isn't necessary
Dim book As Excel.Workbook
Set book = app.Workbooks.Add(ActiveWorkbook.Path & "\QOS DGL stuff.xlsx")
'set up error handeling so if any thing happens the instance of excel with QOS sheets is closed gracefully
On Error GoTo Closebook
' MsgBox book.Sheets("ACLS").Cells(3, 3)
'Do what you have to do
'
Closebook:
On Error Resume Next
book.Close SaveChanges:=False
app.Quit
Set app = Nothing
On Error GoTo 0
Fail:
End Sub
What I want is a single On error - close app and exit sub.
Can anyone provide a sample of what would be considered best practice for doing this?
Cheers
Aaron
So this code below, when the sheet does not exist it will cause the error, why does it not skip the "book.close" statement, I know this throws an error, but I want it to ignore it?
Sub QOScode()
On Error GoTo Closebook
Dim app As New Excel.Application
app.Visible = False
Dim book As Excel.Workbook
Set book = app.Workbooks.Add(ActiveWorkbook.Path & "\QOaS DGL stuff.xlsx") 'this sheet does not exist
'
MsgBox book.Sheets("ACLS").Cells(3, 3)
'Do what you have to do
'
Closebook:
Err.Clear
On Error Resume Next
book.Close SaveChanges:=False 'Object variable or with block variable not set (error 91)
app.Quit
Set app = Nothing
On Error GoTo 0
End Sub
My 2 cents on Error Handling.
You should always do error handling.
Some of the Reasons
1) You wouldn't want your app to break down and leave your users hanging! Imagine the frustration that it would cause them.
2) Error handling doesn't mean that you are trying to ignore error.
3) Error handling is neither defensive programming or aggressive programming. IMHO it is proactive programming.
4) Very few people are aware that you can find out the line which is causing the error. The property that I am talking about is ERL. Consider this example
Sub Sample()
Dim i As Long
Dim j As Long, k As Long
10 On Error GoTo Whoa
20 i = 5
30 j = "Sid"
40 k = i * j
50 MsgBox k
60 Exit Sub
Whoa:
70 MsgBox "Description : " & Err.Description & vbNewLine & _
"Error Number : " & Err.Number & vbNewLine & _
"Error at Line: " & Erl
End Sub
5) In subs like worksheet change event, it is a must to do error handling. Imagine you have set the Enable Event to False and your code breaks! The code won't run next time till you set the events back to true
6) I can go on and on :-) Would recommend this link
Topic: To ‘Err’ is Human
Link: http://www.siddharthrout.com/2011/08/01/to-err-is-human/
Tip:
Use MZ Tools. It is free!
Here is how I would write your code.
Sub QOScode()
Dim app As New Excel.Application
Dim book As Excel.Workbook
10 On Error GoTo Whoa
20 Set book = app.Workbooks.Open(ActiveWorkbook.Path & "\QOS DGL stuff.xlsx")
30 MsgBox book.Sheets("ACLS").Cells(3, 3)
'
'Do what you have to do
'
LetsContinue:
40 On Error Resume Next
50 book.Close SaveChanges:=False
60 Set book = Nothing
70 app.Quit
80 Set app = Nothing
90 On Error GoTo 0
100 Exit Sub
Whoa:
110 MsgBox "Description : " & Err.Description & vbNewLine & _
"Error Number : " & Err.Number & vbNewLine & _
"Error at Line: " & Erl
120 Resume LetsContinue
End Sub
I am not quite sure I understand your objective. If I did, I would probably disagree.
Is this code you are developing? I almost never use error handling in code I am developing. I want the interpreter to stop on the statement that gives the error. I want to understand why that error has occurred. What could I have done to avoid the error? Did I fail to check the file exists? Did I fail to check the path is accessable? I will add the missing code before I do anything else.
By the time you have finished development, you should plan for there to be no error condition for which you have not included proper code. Of course, this is impossible; you cannot make your code foolproof because fools are so ingenious. The version you release to users must contains error handling.
But you could not release this code to users since it would stop without warning. Would the user guess something had gone wrong with the macro or would they assume this was what was supposed to happen? If they decide the macro has failed what are they going to say to you? "It did not do what I was expecting and I do not know why." What are you going to say back? "What were you doing?" I do not think I have ever had a user give a believable description of what they were doing at the time of a failure. At the very least you want:
Call MsgBox("Sorry I have had an unrecoverable error within QOScode()." & _
" Please record: " & Err.Number & " " & Err.Description & _
" and report to extension 1234")
With this, the user does not wonder if something has gone wrong and you know where it went wrong and, with luck, why.
To handle the foreseen issue neatly you can use short error handling to test that the Workbook actually exists (ie If Not Wb Is Nothing Then, if so work on it, with a common ending (ie destroying the object)
The second sample shows how to add additional handling for unforeseen errors once the workbook has been opened.I have used Err.Raise to create deliberate error to give the user a choice as to how to proceed (close the workbook immediately post error or make the workbook visible)
As an aside, don't use Dim and New together. I have re-written
Dim app As New Excel.Application
into
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
1. Handling the no workbook issue
Sub QOScode()
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim Wb As Excel.Workbook
On Error Resume Next
Set Wb = xlApp.Workbooks.Add(ActiveWorkbook.Path & "\QOaS DGL stuff.xlsx") 'this sheet does not exist
On Error GoTo 0 '
If Not Wb Is Nothing Then
MsgBox Wb.Sheets("ACLS").Cells(3, 3)
'Do what you have to do
Wb.Close False
End If
xlApp.Quit
Set xlApp = Nothing
End Sub
2. Handling no workbook and other unforseen error which may otherwise leave the worbook open
Sub QOScode2()
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim Wb As Excel.Workbook
Dim lngChk As Long
On Error Resume Next
Set Wb = xlApp.Workbooks.Add(ActiveWorkbook.Path & "\QOaS DGL stuff.xlsx") 'this sheet does not exist
On Error GoTo 0 '
If Not Wb Is Nothing Then
On Error GoTo ProblemHandler
MsgBox Wb.Sheets("ACLS").Cells(3, 3)
'Do what you have to do
'Deliberate error
Err.Raise 2000, "test code", "Sample Error"
Wb.Close False
Else
MsgBox "Workbook not found,code will now exit"
End If
xlApp.Quit
Set xlApp = Nothing
Exit Sub
ProblemHandler:
'Test to see if workbook was still open when error happened
If Not Wb Is Nothing Then
lngChk = MsgBox("The code encountered an error" & vbNewLine & Err.Number & vbNewLine & "Do you want to close the file?", vbYesNo, Err.Description)
If lngChk = vbYes Then
'close book. Code will proceed to destroy app
Wb.Close False
Else
'make workbook visible and leave code
Wb.Visible = True
Exit Sub
End If
Else
MsgBox "The code encountered an error - the file was already closed at this point" & vbNewLine & "Error number " & Err.Number & vbNewLine, Err.Description
End If
'destroy app (either if the workbook was closed, or user chose to close it)
xlApp.Quit
Set xlApp = Nothing
End Sub
Related
I am trying to assign an opened workbook to an workbook object. If that workbook is not already opened, then it throws an error. I am handling the errors using an Error Handler.
This works for me:
On Error GoTo OpenWorkbookError
Set Uwk = Application.Workbooks(WbkName)
OpenWorkbookError:
If Err <> 0 Then
Err.Clear
MsgBox ("Please Open the Required Workbook")
Exit Sub
End If
But is there a way to avoid using the error handlers in this situation.
One way to do it is check each workbook name, but what's wrong with the functions in the link that #SJR gave?
In your provided code you've kept the error handler within the main body of code - it should appear between the Exit Sub and End Sub at the end of the procedure.
Something like this would work without an error handler, but it's slower as it needs to check each workbook:
Sub Test()
Dim Uwk As Workbook
Dim WbkName As String
WbkName = "PERSONAL.XLSB"
For Each Uwk In Workbooks
If Uwk.Name = WbkName Then
Exit For
End If
Next Uwk
If Not Uwk Is Nothing Then
MsgBox Uwk.Name & " found!"
Else
MsgBox "Not found."
End If
End Sub
Your version of the code should have the error handler outside the main body:
Sub Test1()
Dim WbkName As String
Dim UWk As Workbook
WbkName = "PERSONAL1.XLSB"
On Error GoTo OpenWorkbookError
Set UWk = Workbooks(WbkName)
TidyExit:
'Close anything that needs closing and Exit.
Exit Sub '<< End of main body of procedure.
OpenWorkbookError:
Select Case Err.Number
Case 9 'Subscript out of range.
MsgBox "Please open the required workbook."
Resume TidyExit
Case Else
MsgBox "Error " & Err.Number & vbCr & _
Err.Description, vbOKOnly + vbCritical
Resume TidyExit
End Select
End Sub '<< End of procedure.
I can't find where the error is. A similar code to pull dynamic file name worked in another tab.
Sub MonthlyBCRCPL()
Dim filePath As String
Dim CardsRCPLWb As Workbook
Set CardsRCPLWb = ActiveWorkbook
filePath = CardsRCPLWb.Sheets("BCRCPL").Range("A1").Value
'Optimize Code
Call OptimizeCode_Begin
Const FlashFolder As String = "\\apacdfs\SG\GCGR\GROUPS\ASEAN\Dashboard\Cards\Flash\"
Flashname = Format(CardsRCPLWb.Sheets("ASEAN - CARDS, RCPL").Range("C2").Value, "YYYYMMDD")
Flashname = "ASEAN SD Regional Dashboard - " & Flashname & ".xlsx"
Flashpath = FlashFolder & Flashname
Dim FlashWb As Workbook
Set FlashWb = Workbooks.Open(Flashpath)
If FlashWb Is Nothing Then MsgBox "SD Flash File does not exist": Exit Sub
Consider handling the error in the subroutine and have it raise a message. Then, properly continues/skips/exits rest of code even releasing objects from memory caught during the exception. This is a best practice in VBA (and generally in programming).
I suspect the path cannot be found which looks to be a network UNC, file naming is not valid such as use of special characters, or workbook does not exist when trying to open:
Sub MonthlyBCRCPL()
On Error Goto ErrHandle:
...code...
ExitSubBlock:
Set CardsRCPLWb = Nothing
Set FlashWb = Nothing
Exit Sub
ErrHandle:
Msgbox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Goto ExitSubBlock
' Resume Next
End Sub
This question already has answers here:
Why VBA goes to error handling code when there is no error?
(5 answers)
Closed last year.
I have my code below, the strange thing is that the Errorhandler procedure is still executing even though there are no errors in the code... What can be the issue?
Running the code without any errorhandlers generates no errors, but still the msgbox under Errorhandler shows up when I include an error handling statement!
Code
Public Sub ExportGraphs(Optional PivotExport As Boolean)
' Exports only graphs on the "Mainwindow" sheet to a new worksheet
Dim wsh As Worksheet: Set wsh = Sheets.Add
Dim source_sht As Worksheet: Set source_sht = Sheets("Mainwindow")
ActiveWindow.Zoom = 70
On Error GoTo Errorhandler
With wsh
If source_sht.OLEObjects("Btn_CurrentTime").Object.Value = True Then
.Name = source_sht.OLEObjects("CombBox_Instruments").Object.Value & " " & source_sht.OLEObjects("DTPicker_FROM").Object.Value _
& "-" & source_sht.OLEObjects("DTPicker_TO").Object.Value
Else
.Name = source_sht.OLEObjects("CombBox_Instruments").Object.Value & " " & "Max_Possible_To" _
& "-" & source_sht.OLEObjects("DTPicker_TO").Object.Value
End If
End With
Dim source_chart As ChartObject
Dim target_rng As Range: Set target_rng = wsh.Range("A1")
For Each source_chart In source_sht.ChartObjects
source_chart.CopyPicture xlScreen, xlBitmap
target_rng.PasteSpecial
Set target_rng = target_rng.Offset(20, 0)
Next
If PivotExport = True Then
Debug.Print "se"
End If
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
#dee provided the correct answer.
The Errorhandler: is just a place holder. It does NOT operate like you think. You are using it like an If... Then... statement:
If Error Then
Show MsgBox
Else
Skip MsgBox
End If
As the Errorhandler is just a placeholder and NOT an If... Then..., the code after the placeholder will run regardless of error or no error. To rectify this issue, add an Exit Sub above the Errorhandler: line:
Exit Sub
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
In this piece of code, ErrorHandler: is what is known as a line label.
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
Line labels are not executable code, but rather just a marker that can tell other code where to jump to via any GoTo Statement. Armed with this knowledge, they are obviously not exclusive to error handlers.
The solution here is to use the Exit Statement to return from the Sub "early".
Exit Sub
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
Others may disagree with me, but I like to build my error handling so that the code always stops execution on Exit Sub. If the code ends its execution on End Sub, something has gone wrong.
This question has been edited due to lengthy comments and updates from proposed answers.
As requested here is module 13;
Sub SaveInFormat()
Application.DisplayAlerts = False
Workbooks.Application.ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data\" & Format(Date, "yyyymm") & "DB" & ".xlsx", leFormat:=51
Application.DisplayAlerts = True
End Sub
Also there are issues with the errorhandling, I know I've gone wrong with it but I'm more interested in fixing the close function at the moment before I get into it. Here is the error handling code that needs some work
Sub test()
Dim wk As String, yr As String, fname As String, fpath As String
Dim owb As Workbook
wk = ComboBox1.Value
yr = ComboBox2.Value
fname = yr & "W" & wk
fpath = "C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data"
owb = Application.Workbooks.Open(fpath & "\" & fname)
On Error GoTo ErrorHandler:
ErrorHandler:
If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then Exit Sub Else Call Clear
'Do Some Stuff
Call Module13.SaveInFormat
owb.Close
this is your test code plus my changing of the file path and name
After discussion posting updated answer:
Option Explicit
Sub test()
Dim wk As String, yr As String
Dim fname As String, fpath As String
Dim owb As Workbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With
wk = ComboBox1.Value
yr = ComboBox2.Value
fname = yr & "W" & wk
fpath = "C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data"
On Error GoTo ErrorHandler
Set owb = Application.Workbooks.Open(fpath & "\" & fname)
'Do Some Stuff
With owb
.SaveAs fpath & Format(Date, "yyyymm") & "DB" & ".xlsx", 51
.Close
End With
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
End With
Exit Sub
ErrorHandler: If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then
Else: Call Clear
End Sub
Error Handling:
You could try something like this to catch a specific error:
On Error Resume Next
Set owb = Application.Workbooks.Open(fpath & "\" & fname)
If Err.Number = 1004 Then
GoTo FileNotFound
Else
End If
...
Exit Sub
FileNotFound: If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then
Else: Call Clear
I'll try and answer several different things, however my contribution may not cover all of your questions. Maybe several of us can take different chunks out of this. However, this info should be helpful for you. Here we go..
Opening A Seperate File:
ChDir "[Path here]" 'get into the right folder here
Workbooks.Open Filename:= "[Path here]" 'include the filename in this path
'copy data into current workbook or whatever you want here
ActiveWindow.Close 'closes out the file
Opening A File With Specified Date If It Exists:
I'm not sure how to search your directory to see if a file exists, but in my case I wouldn't bother to search for it, I'd just try to open it and put in some error checking so that if it doesn't exist then display this message or do xyz.
Some common error checking statements:
On Error Resume Next 'if error occurs continues on to the next line (ignores it)
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
Or (better option):
if one doesn't exist then bring up either a message box or dialogue
box to say "the file does not exist, would you like to create a new
one?
you would most likely want to use the GoTo ErrorHandler shown below to achieve this
On Error GoTo ErrorHandler:
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
ErrorHandler:
'Display error message or any code you want to run on error here
Much more info on Error handling here: http://www.cpearson.com/excel/errorhandling.htm
Also if you want to learn more or need to know more generally in VBA I would recommend Siddharth Rout's site, he has lots of tutorials and example code here:
http://www.siddharthrout.com/vb-dot-net-and-excel/
Hope this helps!
Example on how to ensure error code doesn't run EVERYtime:
if you debug through the code without the Exit Sub BEFORE the error handler you'll soon realize the error handler will be run everytime regarldess of if there is an error or not. The link below the code example shows a previous answer to this question.
Sub Macro
On Error GoTo ErrorHandler:
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
Exit Sub 'Code will exit BEFORE ErrorHandler if everything goes smoothly
'Otherwise, on error, ErrorHandler will be run
ErrorHandler:
'Display error message or any code you want to run on error here
End Sub
Also, look at this other question in you need more reference to how this works:
goto block not working VBA
New to vba, trying an 'on error goto' but, I keep getting errors 'index out of range'.
I just want to make a combo box that is populated by the names of worksheets which contain a querytable.
For Each oSheet In ActiveWorkbook.Sheets
On Error GoTo NextSheet:
Set qry = oSheet.ListObjects(1).QueryTable
oCmbBox.AddItem oSheet.Name
NextSheet:
Next oSheet
I'm not sure whether the problem is related to nesting the On Error GoTo inside a loop, or how to avoid using the loop.
The problem is probably that you haven't resumed from the first error. You can't throw an error from within an error handler. You should add in a resume statement, something like the following, so VBA no longer thinks you are inside the error handler:
For Each oSheet In ActiveWorkbook.Sheets
On Error GoTo NextSheet:
Set qry = oSheet.ListObjects(1).QueryTable
oCmbBox.AddItem oSheet.Name
NextSheet:
Resume NextSheet2
NextSheet2:
Next oSheet
As a general way to handle error in a loop like your sample code, I would rather use:
on error resume next
for each...
'do something that might raise an error, then
if err.number <> 0 then
...
end if
next ....
How about:
For Each oSheet In ActiveWorkbook.Sheets
If oSheet.ListObjects.Count > 0 Then
oCmbBox.AddItem oSheet.Name
End If
Next oSheet
Actualy the Gabin Smith's answer needs to be changed a bit to work, because you can't resume with without an error.
Sub MyFunc()
...
For Each oSheet In ActiveWorkbook.Sheets
On Error GoTo errHandler:
Set qry = oSheet.ListObjects(1).QueryTable
oCmbBox.AddItem oSheet.name
...
NextSheet:
Next oSheet
...
Exit Sub
errHandler:
Resume NextSheet
End Sub
There is another way of controlling error handling that works well for loops. Create a string variable called here and use the variable to determine how a single error handler handles the error.
The code template is:
On error goto errhandler
Dim here as String
here = "in loop"
For i = 1 to 20
some code
Next i
afterloop:
here = "after loop"
more code
exitproc:
exit sub
errhandler:
If here = "in loop" Then
resume afterloop
elseif here = "after loop" Then
msgbox "An error has occurred" & err.desc
resume exitproc
End if
I do not want to craft special error handlers for every loop structure in my code so I have a way of finding problem loops using my standard error handler so that I can then write a special error handler for them.
If an error occurs in a loop, I normally want to know about what caused the error rather than just skip over it. To find out about these errors, I write error messages to a log file as many people do. However writing to a log file is dangerous if an error occurs in a loop as the error can be triggered for every time the loop iterates and in my case 80 000 iterations is not uncommon. I have therefore put some code into my error logging function that detects identical errors and skips writing them to the error log.
My standard error handler that is used on every procedure looks like this. It records the error type, procedure the error occurred in and any parameters the procedure received (FileType in this case).
procerr:
Call NewErrorLog(Err.number, Err.Description, "GetOutputFileType", FileType)
Resume exitproc
My error logging function which writes to a table (I am in ms-access) is as follows. It uses static variables to retain the previous values of error data and compare them to current versions. The first error is logged, then the second identical error pushes the application into debug mode if I am the user or if in other user mode, quits the application.
Public Function NewErrorLog(ErrCode As Variant, ErrDesc As Variant, Optional Source As Variant = "", Optional ErrData As Variant = Null) As Boolean
On Error GoTo errLogError
'Records errors from application code
Dim dbs As Database
Dim rst As Recordset
Dim ErrorLogID As Long
Dim StackInfo As String
Dim MustQuit As Boolean
Dim i As Long
Static ErrCodeOld As Long
Static SourceOld As String
Static ErrDataOld As String
'Detects errors that occur in loops and records only the first two.
If Nz(ErrCode, 0) = ErrCodeOld And Nz(Source, "") = SourceOld And Nz(ErrData, "") = ErrDataOld Then
NewErrorLog = True
MsgBox "Error has occured in a loop: " & Nz(ErrCode, 0) & Space(1) & Nz(ErrDesc, "") & ": " & Nz(Source, "") & "[" & Nz(ErrData, "") & "]", vbExclamation, Appname
If Not gDeveloping Then 'Allow debugging
Stop
Exit Function
Else
ErrDesc = "[loop]" & Nz(ErrDesc, "") 'Flag this error as coming from a loop
MsgBox "Error has been logged, now Quiting", vbInformation, Appname
MustQuit = True 'will Quit after error has been logged
End If
Else
'Save current values to static variables
ErrCodeOld = Nz(ErrCode, 0)
SourceOld = Nz(Source, "")
ErrDataOld = Nz(ErrData, "")
End If
'From FMS tools pushstack/popstack - tells me the names of the calling procedures
For i = 1 To UBound(mCallStack)
If Len(mCallStack(i)) > 0 Then StackInfo = StackInfo & "\" & mCallStack(i)
Next
'Open error table
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("tbl_ErrLog", dbOpenTable)
'Write the error to the error table
With rst
.AddNew
!ErrSource = Source
!ErrTime = Now()
!ErrCode = ErrCode
!ErrDesc = ErrDesc
!ErrData = ErrData
!StackTrace = StackInfo
.Update
.BookMark = .LastModified
ErrorLogID = !ErrLogID
End With
rst.Close: Set rst = Nothing
dbs.Close: Set dbs = Nothing
DoCmd.Hourglass False
DoCmd.Echo True
DoEvents
If MustQuit = True Then DoCmd.Quit
exitLogError:
Exit Function
errLogError:
MsgBox "An error occured whilst logging the details of another error " & vbNewLine & _
"Send details to Developer: " & Err.number & ", " & Err.Description, vbCritical, "Please e-mail this message to developer"
Resume exitLogError
End Function
Note that an error logger has to be the most bullet proofed function in your application as the application cannot gracefully handle errors in the error logger. For this reason, I use NZ() to make sure that nulls cannot sneak in. Note that I also add [loop] to the second identical error so that I know to look in the loops in the error procedure first.
What about?
If oSheet.QueryTables.Count > 0 Then
oCmbBox.AddItem oSheet.Name
End If
Or
If oSheet.ListObjects.Count > 0 Then
'// Source type 3 = xlSrcQuery
If oSheet.ListObjects(1).SourceType = 3 Then
oCmbBox.AddItem oSheet.Name
End IF
End IF