What to do when VBA Error handler causes error? - excel

I am currently working on a larger program which may throw an error at some point. So I added an error handler for that case. The primary goal of which is to close the opened excel workbook wbk so that I don't get too many excel-applications running in the background. As I don't know, which part of the program may cause the error, I don't know the state of wbk and whether it is open or not. I tried adding a check for Nothing but wbk is Nothing seems to be false at that point. With the following code I will get The remote server machine does not exist or is unavailable (Error 462) when the error handler is called:
Error Handler
On Error Resume Next
resp = MsgBox(prompt:="Es ist ein Fehler aufgetreten! " & vbCrLf & vbCrLf & "Soll versucht werden weiter fortzufahren?" & _
vbCrLf & vbCrLf & "Fehlercode: " & str(Err.Number) & " entstanden durch " & Err.Source & Chr(13) & Err.Description, _
Buttons:=vbCritical + vbYesNo + vbDefaultButton1, _
title:="Unbekannter Fehler", _
HelpFile:=Err.HelpFile, _
Context:=Err.HelpContext)
If Not wbk Is Nothing Then
wbk.Close False
End If
If resp = vbNo Then Exit Sub
Resume Next
Afaik, I shouldn't even get an error because of the On Error Resume Next. Edit: It should since "The error hander is still active when the second error occurs, and therefore the second error is not trapped by the On Error statement." - source
TL;DR: wbk should be closed in error handling if it is open, but it throws an error.
Edit:
I force an error in order to call the error handler. Said error does only happen in the second execution so the wbk value is set normally, then the workbook is closed and the program is called again and the error is forced before wbk is initialized again.

During the second execution, wbk has whatever value it has after wbk.Close was called, this is not Nothing. I did now explicitly set Set wbk = Nothing after closing and the error does no longer happen, due to the Nothing check above.
Btw. I changed the responses around since it doesn't really make sense to close the workbook when the code is resumed.

Related

VBS code is finding the file with oFSO.FileExist but giving an error = 1004 when trying to run Application.Run

Good evening. I'm trying to schedule an excel macro through task scheduler. I've got the below code written for opening the excel file and running the code however it's kicking out an error when it's hitting the Application.Run step.
Does anyone have any ideas where i'm going wrong?
On Error Resume Next
Set oFSO = CreateObject("Scripting.FileSystemObject")
set oFile = oFSO.CreateTextFile("c:\scripts\log.txt")
Set oExcel = WScript.CreateObject("Excel.Application")
If oFSO.FileExist("C:\scripts\Excel Files\my_excel_file.xlsm") then
oFile.WriteLine "File Exists"
oExcel.Application.Run "'C:\scripts\Excel Files\my_excel_file.xlsm'!RefreshAll"
if err.number <> 0 then
oFile.WriteLine "error = " & err.number & " " & err.description
end if
Else
oFile.WriteLine "File does not exist"
End If
oExcel.Application.close
I originally had the file on a network drive which I thought would be the issue so i've moved it to the C: Drive on a remote desktop to try and counter that issue.
I initially thought it was a task scheduler issue, however the log is being filled out which tells me there's something else going on. I've set up the action as the attached image.

Excel VBA Automation error: The object invoked has disconnected from its clients -- inconsistent error

There are a number of issues with this error, but none seem to match my case exactly so posting in the hope of some help.
I have a macro which takes all the files in a directory, opens them silently in a new (hidden) instance of Excel and does two "Save As" operations: one to a location on SharePoint and one to an archive folder. The purpose of this is that the files are produced by SAS in XML format with an XLS extension. Saving them as native XLSX reduces file size dramatically.
Each day we produce a number of files which we then run the macro on. It has been erroring on the same file each day; that is to say it's not exactly the same file, but the same report with different versions each day. It is the largest of the files, but other than that there's nothing outstanding about it.
There are two other oddities:
When running the code step-by-step with F8, the error doesn't occur - this has meant I've been unable to pinpoint exactly where it's erroring;
The code has an option to skip files that error - when skipping and rerunning it again immediately afterwards, with no other changes, the error doesn't occur the second time.
Here's the code; the macro is called different times with different locations as parameters:
Sub LoopThroughDirectory(inPath As String, sharepointPath As String, archivePath As String)
Dim sDir As String
Dim app As New Excel.Application
Dim wb As Excel.Workbook
Dim mbErr As Integer, mbFinished As Integer
If Right(inPath, 1) <> "\" Then inPath = inPath & "\"
On Error GoTo ErrHandler:
sDir = Dir$(inPath, vbNormal)
Do Until Len(sDir) = 0
On Error GoTo LoopError:
app.Visible = False
app.DisplayAlerts = False
Set wb = app.Workbooks.Add(inPath & sDir)
With wb
.SaveAs Filename:=sharepointPath & Left(.Name, InStrRev(.Name, ".")) & "xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, ReadOnlyRecommended:=True
.SaveAs Filename:=archivePath & Left(.Name, InStrRev(.Name, ".")) & "xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close SaveChanges:=False
End With
Set wb = Nothing
app.DisplayAlerts = True
app.Quit
Kill (inPath & sDir) ' delete the file
NextFile:
sDir = Dir$ ' find the next filename
Loop
mbFinished = MsgBox( _
"The process has finished. You may need to review any files that have errored.", _
vbOKOnly, _
"Process finished" _
)
On Error GoTo 0
Exit Sub
ErrHandler:
mbErr = MsgBox( _
"There has been an error finding files. Check the SharePoint folder and try again.", _
vbCritical + vbOKOnly, _
"Error finding files" _
)
On Error GoTo 0
Exit Sub
LoopError:
Select Case MsgBox("There has been an error with " & sDir & "." & vbCrLf & vbCrLf & _
"The error is " & vbCrLf & vbCrLf & _
Err.Description & "." & vbCrLf & vbCrLf & _
"Press OK to continue with the next file or Cancel to stop the process.", _
vbCritical + vbOKCancel, "Error")
Case vbOK
Resume NextFile ' go back and try the next file
Case vbCancel
On Error GoTo 0
Exit Sub ' stop processing the files
End Select
End Sub
I suggest to insert the sub below underneath your existing code, outside your procedure but in the same code module.
Private Sub WaitASecond(ByVal Sec As Single)
Dim WaitTill As Single
WaitTill = Timer + Sec
Do
DoEvents
Loop While Timer < WaitTill
End Sub
Call it from your main procedure with a line of code like this.
WaitASecond(0.5) ' which would wait for half a second
Experiment with both the length of time, in increments of 0.25 seconds, if you like, and the location of the code. Bear in mind that it seems that your biggest file creates the problem. So, you might limit the call to that one file or vary the length of the wait depending upon the file size (if it makes a significant difference to your process).
You might instroduce a wait after each SaveAs, only after both SaveAs and/or after the Kill.

Handling incorrect password runtime errors

First time post but a long time user! Firstly I wanted to say thank you to every for all the code feedback you guys put on posts. It's helped me develop my VBA code more than you can imagine!
Ok so the question:
Background:
I'm developing a VBA focused addin for myself and colleagues to use. Part of this is include functions that you would except in Excel but aren't there. Some of these were quite easy to do (ie invert filters) but some are proving more difficult. This is one of those examples.
Issue:
The following code is meant to loop through the users selection of sheets, apply a user defined password or remove the existing one. Part of the function is to capture passwords that can't be removed (ie becuase the user entered an incorrect password). It works great for the first error occurrence but throughs up the runtime error (1004) for the second and repeating ones after. I don't much much experience with runtime errors handling (try to avoid errors!) but I can't get this to work. Any ideas /help to stop the runtime error popping up would be great.
Code:
Dim SHT As Worksheet, Password As String, SHT_Names(0 To 30) As String
'PREP
'DISABLE APPLICATION FUNCTIONS
Call Quicker_VBA(False)
Application.EnableEvents = False
'USER PASSWORD OPTION
Password = InputBox("Please enter a password (leave blank for no password)", "Password")
'USER INFORMATION MESSAGES SETUP
MSG_Protect = "Added to-"
Protect_check = MSG_Protect
MSG_Unprotect = "Removed from-"
Unprotect_check = MSG_Unprotect
MSG_unable = "Unable to remove protection from-"
Unable_check = MSG_unable
'ID SHEETS SELECTED
For Each SHT In ActiveWindow.SelectedSheets
a = a + 1
SHT.Activate
SHT_Names(a) = SHT.name
Next
'MAIN
HomeSHT = ActiveSheet.name
'PROTECT SHEETS SELECTED BY USER
For b = 1 To a
Sheets(SHT_Names(b)).Select
Set SHT = ActiveSheet
'ENABLE OR REMOVE PROTECTION FROM SELECTED SHEET
If SHT.ProtectContents Then
On Error GoTo Password_FAIL
Application.DisplayAlerts = False
SHT.Unprotect Password
On Error GoTo 0
MSG_Unprotect = MSG_Unprotect & vbNewLine & Chr(149) & " " & SHT.name
Else:
'ENABLE FILTER CHECK
FilterOn = False
If ActiveSheet.AutoFilterMode Then FilterOn = True
'PROTECT SHEET
SHT.Protect Password, AllowFiltering:=FilterOn
'UPDATE USER MESSAGE
MSG_Protect = MSG_Protect & vbNewLine & Chr(149) & " " & SHT.name & " - Users can: Select locked and unlocked cells"
If FilterOn = True Then MSG_Protect = MSG_Protect & " and use filters"
End If
200 Next
'INFORM USER
If Protect_check <> MSG_Protect Then msg = MSG_Protect & vbNewLine & "___________________" & vbNewLine
If Unprotect_check <> MSG_Unprotect Then msg = msg & MSG_Unprotect & vbNewLine & "___________________" & vbNewLine
If Unable_check <> MSG_unable Then msg = msg & MSG_unable
MsgBox msg, , "Protection summary"
'TIDY UP
Sheets(HomeSHT).Activate
'ENABLE APPLICATION FUNCTIONS
Call Quicker_VBA(True)
Exit Sub
Password_FAIL:
MSG_unable = MSG_unable & vbNewLine & Chr(149) & " " & SHT.name
Application.EnableEvents = False
GoTo 200
End Sub
At a quick glance, it seems that the problem is in the way you're handling your errors. You use the line On Error GoTo Password_FAIL to jump down to the error handler. The error handler logs some information and then jumps up to label '200'. I can't tell if the formatting is off, but it looks like the label for '200' points to Next, indicating that the loop should continue with the next sheet.
So, where's the problem? You never actually reset the original error. Three lines below On Error GoTo Password_FAIL you explicitly call On Error GoTo 0 to reset the error handler, but that line will never actually be reached in an error. The program will jump to the error handler, and then from there jump up to the loop iterator. Using the GoTo statement for control flow can easily lead to these types of issues, which is why most developers recommend against it.
I'll post some sample code below to show a different (potentially better) way to handle code exceptions. In the sample below, the code simply loops through all of the worksheets in the workbook and toggles the protection. I didn't include much of your logging, or the constraint that only the selected sheets be toggled. I wanted to focus on the error handling instead. Besides, from reading you code, it seems that you can manage more of the peripheral details. Send a message if there's still some confusion
Sub ToggleProtectionAllSheets()
Dim sht As Worksheet
Dim password As String
On Error Resume Next
password = InputBox("Please enter a password (leave blank for no password)", "Password")
For Each sht In ActiveWorkbook.Worksheets
If sht.ProtectContents Then
sht.Unprotect password
If Err.Number <> 0 Then
Err.Clear
MsgBox "Something did not work according to plan unprotecting the sheet"
End If
Else
sht.Protect password
If Err.Number <> 0 Then
Err.Clear
MsgBox "Something went wrong with protection"
End If
End If
Next sht
End Sub

Indentation of Error Handler in Excel VBA

This is a very fussy question: I am inserting an Error Handler in a For To loop in Excel VBA; I want the content of the loop indented, such that:
For i = 0 to n
On Error GoTo ErrorHandler:
'~~> code here
ErrorHandler:
'~~> code here
Resume NextLoop
NextLoop:
Next
However, Excel VBA automatically cancels indentation of Error Handlers:
For i = 0 to n
On Error GoTo ErrorHandler:
'~~> code here
ErrorHandler:
'~~> code here
Resume NextLoop
NextLoop:
Next
I have tried to unselect option "Auto Indent" in "Tools" > "Options" > "Editor" but this hasn't worked.
How can I avoid this?
Edit There was a careless mistake in the original code. Thank you user2426679 for giving me the opportunity to fix it.
Original post
Code that uses GoTo Label can be a nightmare to understand and get error free. The only situation I know off in which GoTo Label might be appropriate is a fatal error exit where there is no intention to return. Jumping out of an error and trying to jump back is very difficult to get right and very difficult to understand when you return to it in a few months.
Is there more than one statement in your code that can throw an error? If so, how does the error handler know which error it is handling?
I favour:
On Error Resume Next ' Suspend normal error handling
Statement that might throw an error
On Error GoTo 0 ' Restore normal error handling
If Err.Number <> 0 then
' Code to handle error
End If
The value of Err.Number and Err.Description will tell what the error is and allow to write specific error handling code.
Some argue that taking error handling out of the main code keeps the main code clean. There is some merit in this argument. If there are dozens of potential errors, the analysis can become complicated and make the normal path difficult to isolate. But, in my experience, this is very unusual. Perhaps, you have a list of files some of which might not open. There are lots of reasons why a file does open but your code can do nothing about them. All it can do is display Err.Description and move onto the next file.
New text and code
Apart from the mistake in the code there is nothing in my original post that I now consider incorrect. However, I do not think the original post was as complete as it should be.
If you search for “VBA Err.Number” you will find sites that list VBA’s error handling codes. Since these sites come and go, I will not recommend my favourite. However, I try to generate errors to see what happens. Consider this code:
Option Explicit
Sub DemoErrorHandling()
Dim ErrDesc As String
Dim ErrNum As Long
Dim FileNum As Long
Dim PathFile As Variant
FileNum = FreeFile
For Each PathFile In Array("", "X:", "C:\Program Files\Common Files\Intel\" & _
"WirelessCommon\libeay32.dll")
On Error Resume Next
Open PathFile For Input As FileNum
ErrNum = Err.Number
ErrDesc = Err.Description
Close FileNum
On Error GoTo 0
Debug.Print """" & PathFile & """ gives error:"
Debug.Print " A " & Err.Number & " " & Err.Description
Debug.Print " B " & ErrNum & " " & ErrDesc
Next
End Sub
Which, on my system, outputs:
"" gives error:
A 0
B 75 Path/File access error
"X:" gives error:
A 0
B 76 Path not found
"C:\Program Files\Common Files\Intel\WirelessCommon\libeay32.dll" gives error:
A 0
B 0
Note, as user2426679 pointed out, On Error GoTo 0has cleared Err.Number and Err.Description. Only by saving these values in variables are they available for testing. Note, attempting to open an empty file name and a non-existent disc give different errors.
My code demonstrates that you can loop trying different files until one opens successfully. You could keep asking the user for a file until one opened without an error.

Error Handling doesn't handle

I have written an excel VBA script which refers to another open excel document for some of it's data. Recently it has come to my attention that if this secondary document is closed unexpectedly by the user, the primary script ceases to work. Obviously, I need to check to be sure it is open before I search it.
Below is the code I came up with to verify that the workbook is open. If it is, I format it. If it isn't, I open it (which triggers it's own formatting). The problem comes in because my error handler catches the "Object required" error number 424. I try to take care of that by instructing it to just resume next when this happens. Unfortunately it seems to want to pick case else rather than case 424 and stops the script.
On Error GoTo searchGridsError
GridName = Workbooks(SALTname).Sheets(2).Range("B3").value
If Verify.FirstOption.value = True Then
Set Verify.groupGrid = Workbooks(GridName)
If Verify.groupGrid Is Nothing Then
Verify.checkForGrids
Else
formatWorkbook
End If
End If
Below is my error handler:
searchGridsError:
Select Case Err
Case 18
Verify.clearData
Exit Function
Case 424
Resume Next
Case Else
MsgBox "An error has occurred while searching the customer number grid. Please try again or search manually."
Module1.ReportError Err.Number, Erl, Err.Description, "searchGrids", Verify.Address1Box & "," & Verify.Address2Box & "," & Verify.CityBox & "," & Verify.StateBox & "," & Verify.ZipBox & "," & Verify.ContractBox & "," & Verify.PBPBox & "," & Verify.CountyBox
Verify.clearData
Exit Function
End Select
End Function
Does anyone have any ideas about why this is happening? It has to be in the error handler but I have seen many, many examples that look just like mine.
As guitarthrower stated in the comments, simply putting Resume Next in your error handling does not resume your macro back where the error occurred. To do that you would need to put another placeholder after your On Error GoTo searchGridsError line like RestartHere: where you want to jump back to and then replace Resume Next with:
On Error Resume Next
GoTo RestartHere
However, this will bypass your error handling once Error 424 is encountered, so you should be wary of how it is used.
Probably a better solution would be to put your error handling right in your code where you expect the error to occur. You can leave your code mostly as-is. However, right before the line that is throwing Error 424, you add On Error Resume Next. Then after the line in question, you add the following:
If Err.Number = 424 Then
Err.Clear
End If
On Error GoTo searchGridsError

Resources