excel multiple on error goto - vba

I am trying to get multiple on error statements to work and can't figure it out.
If pdf can be found in local then open, if not then open network location. If there is no PDF in then return msgbox.
Sub Cutsheets()
Application.ScreenUpdating = False
Dim finalrow As Integer
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
On Error GoTo net1
If Not Application.Intersect(ActiveCell, Range("A9:A" & finalrow)) Is Nothing Then
'Local Location
ActiveWorkbook.FollowHyperlink "C:\Local" & ActiveCell & ".pdf"
Application.SendKeys "{ENTER}", True
End If
Exit Sub
net1:
If Not Application.Intersect(ActiveCell, Range("A9:A" & finalrow)) Is Nothing Then
'Network Location
On Error GoTo whoa
ActiveWorkbook.FollowHyperlink "P:\Network" & ActiveCell & ".pdf"
Application.SendKeys "{ENTER}", True
End If
Exit Sub
whoa:
MsgBox ("No cutsheet can be found for this item.")
Application.ScreenUpdating = True
End Sub
Also I don't remember why I put sendkeys in there but it doesn't work without it.

Using multiple On Error Goto XYZ handlers for control flow is over-complicating some easy validation checks you can do and then simply use the error handling for actual errors.
As #Rory pointed out in a comment you can use the Dir function. You can combine the use of Dir with an If...ElseIf...Else...End If construct to control what you code does:
Option Explicit
Sub Cutsheets()
On Error GoTo ErrHandler
Dim strLocalCheck As String
Dim strNetworkCheck As String
'check for files - Dir will return "" if file not found
strLocalCheck = Dir("C:\Local" & ActiveCell.Value & ".pdf")
strNetworkCheck = Dir("P:\Network" & ActiveCell.Value & ".pdf")
'control flow
If strLocalCheck <> "" Then
ActiveWorkbook.FollowHyperlink strLocalCheck
Application.SendKeys "{ENTER}", True
ElseIf strNetworkCheck <> "" Then
ActiveWorkbook.FollowHyperlink strNetworkCheck
Application.SendKeys "{ENTER}", True
Else
MsgBox "No cutsheet can be found for this item."
End If
Exit Sub
ErrHandler:
Debug.Print "A real error occurred: " & Err.Description
End Sub

I am trying to get multiple on error statements to work
Don't.
Imagine you're the VBA runtime. You're executing a procedure called Cutsheets, and you come across this instruction:
On Error GoTo net1
From that point on, before you blow up in the user's face, you're going to jump to the net1 label if you ever encounter a run-time error. So you keep running instructions. Eventually you run this line:
ActiveWorkbook.FollowHyperlink "C:\Local" & ActiveCell & ".pdf"
And when the FollowHyperlink method responds with "uh nope, can't do that" and raises a run-time error, your execution context changes.
You're in "error handling" mode.
So you jump to the net1 label. You're in "error handling" mode. There are certain things you can do in "normal execution mode" that you can't (or shouldn't) do in "error handling mode". Raising and handling more errors is one of these things.
On Error GoTo whoa
You're already handling a run-time error: what should you do when you encounter that statement in an error handler subroutine? Jump to the whoa right away?
When the VBA runtime is in "error handling mode", your job as a programmer is to handle runtime errors and do everything you can to get back to "normal execution mode" as soon as possible - and that's normally done with a Resume instruction, or by leaving the current scope.
Copying a chunk of code from the "normal execution path" and trying to run it (slightly altered) in "error handling mode" isn't handling errors and getting back to normal execution mode as soon as possible.
Error handling or not, copy-pasting chunks of code is poorly written code anyway.
Extract a procedure instead:
Private Sub OpenPortableDocumentFile(ByVal path As String)
On Error GoTo ErrHandler
ActiveWorkbook.FollowHyperlink path
Application.SendKeys "{ENTER}", True
Exit Sub
ErrHandler:
MsgBox "Could not open file '" & path & "'."
End Sub
Now that that's out of the way, clean up your control flow by verifying if the file exists before you pass an invalid path to the OpenPortableDocumentFile procedure.
The best error handling strategy is to avoid raising run-time errors in the first place.

Related

How to trace a 400 error in VBA?

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

VBA - error handing for non-existent web resource (Yahoo finance)

My macro generates yahoo ticker download URL's for specific companies. I generate 3 URL's per ticker, each having a different date segment for the data download.
The problem that I have, is that data does not exist for some of the dates, hence an error is returned from Yahoo which causes my Macro to crash.
I've attempted the following with a GOTO label:-
On Error GoTo error_handler
Workbooks.Open Filename:=("http://chart.finance.yahoo.com/table.csv?s=FAN.L&a=2&b=04&c=2014&d=2&e=21&f=2014&g=d&ignore=.csv")
however this does not work, it does not GOTO the label.
Any ideas would be greatly appreciated.
Try this:
On Error Resume Next
Workbooks.Open Filename:=("http://chart.finance.yahoo.com/table.csv?s=FAN.L&a=2&b=04&c=2014&d=2&e=21&f=2014&g=d&ignore=.csv")
On Error GoTo error_handler
The On Error Resume Next will allow it to the skip ahead.
Download the file with seperate error handling and then if-check
If Dir(MyFileName) <> "" Then
Workbooks.Open Filename:="C:\123.xls"
Else
MsgBox "Spreadsheet could not be found in C:\", vbCritical + vbOKOnly, "File not found"
End If
Here is some example of error handling. Replace your code with the Debug.print 5/0 and it should work.
Public Sub ErrorHandlingExample()
On Error GoTo ErrorHandlingExample_Error
Debug.Print 5 / 0
On Error GoTo 0
Debug.Print "No error"
Exit Sub
ErrorHandlingExample_Error:
Debug.Print "Error was found - " & Err.Description
End Sub

Looping, copy a list of files from one destination to the next VBA

The following macro I am trying to use to move files in one location to another from an excel spreadsheet. The copy and pastes are used to copy the formula driven "source location" and "destination location" to new columns, to be used in the macro.
I keep getting the error? What is not right right with my approach?
Sub Combine()
Paste_Values
Paste_Values_Two
Copy_Files
End Sub
Sub Paste_Values()
Range("C2:C1000").Copy
Range("E2").PasteSpecial (xlPasteValues)
End Sub
Sub Paste_Values_Two()
Range("D2:D1000").Copy
Range("F2").PasteSpecial (xlPasteValues)
End Sub
Sub Copy_Files()
On Error GoTo ErrorHandler
Dim cell As Range
For Each cell In Range("E2", Range("E" & Rows.Count).End(xlUp))
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 1).Value
Next cell
Exit Sub
ErrorHandler:
MsgBox "NOT WORKING"
End Sub
Many thanks
Since you do not provide any information at the error handling you do not know what exactly happens. However the only function which seems to be able to give an error is FileCopy:
If you try to use the FileCopy statement on a currently open file, an error occurs.
To show the error you can:
Disable the error handling (On Error GoTo ErrorHandler). This gave me the error: "Run-time error '53': File not found", but is not really user friendly since it stops the script.
You probably want something more informative, and handle this situation (by giving a message, and continuing to the following item). A more informative error message can be:
Msg = "Error # " & Str(Err.Number) & ": " & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
You might want to change the error handling to:
ErrorHandler:
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & ": " & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If
Resume Next
With Resume Next the For Each loop is continued.
Edit 1: If you get the error, are you sure that your files exist? You mentioned in your comments you have files like: Z:\1. Pro\XYZ\08_Decision_Tracker\5. M\1006\Mel.docx, are you completely sure the path is correct, do all the (sub)directories exist? And do you have write permission to Z:?

On Error GoTo statement is still executing although there is no error generated [duplicate]

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.

vba error handling in loop

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