I am using below code, When user click on cancel button in the input box, the error is being handled by the error handler.
But if there is error again in the error handler then that error is not getting handled by the error handler.
Sub calculateroot()
Dim msg As String, t as Integer
On Error GoTo myhandle
Dim inp As Integer, sql As Single
inp = InputBox("Enter the number to find the square root")
sql = Sqr(inp)
Exit Sub
myhandle:
t = InputBox("Is this recursive ?")
End Sub
What changes should I make in the code to handle the error generated in error handler ?
You have to reset the error handler and then set a new one:
Sub calculateroot()
Dim msg As String, t As Integer
On Error GoTo myhandle
Dim inp As Integer, sql As Single
inp = inputbox("Enter the number to find the square root")
sql = Sqr(inp)
Exit Sub
myhandle:
On Error GoTo -1
On Error GoTo myhandle2
t = inputbox("Is this recursive ?")
MsgBox t
Exit Sub
myhandle2:
MsgBox "myhandle2"
End Sub
If you need to resume, this disgusting code works:
On Error Resume Next
parm = "bla"
DoSomething(parm)
If Err.Number > 0 Then
Err.Clear
parm = "oldbla"
DoSomething(parm)
End If
If Err.Number > 0 Then
Err.Clear
parm = "evenolderbla"
DoSomething(parm)
End If
Related
Option Compare Database
Function ap_DisableShift()
'This function disable the shift at startup. This action causes
'the Autoexec macro and Startup properties to always be executed.
On Error GoTo errDisableShift
Dim db As DAO.Database
Dim prop As DAO.Property
Const conPropNotFound = 3270
Set db = CurrentDb()
'This next line disables the shift key on startup.
db.Properties("AllowByPassKey") = FALSE
'The function is successful.
Exit Function
errDisableShift:
'The first part of this error routine creates the "AllowByPassKey
'property if it does not exist.
If Err = conPropNotFound Then
Set prop = db.CreateProperty("AllowByPassKey", _
dbBoolean, False)
db.Properties.Append prop
Resume Next
Else
MsgBox "Function 'ap_DisableShift' did not complete successfully."
Exit Function
End If
End Function
Function ap_EnableShift()
'This function enables the SHIFT key at startup. This action causes
'the Autoexec macro and the Startup properties to be bypassed
'if the user holds down the SHIFT key when the user opens the database.
On Error GoTo errEnableShift
Dim db As DAO.Database
Dim prop As DAO.Property
Const conPropNotFound = 3270
Set db = CurrentDb()
'This next line of code disables the SHIFT key on startup.
db.Properties("AllowByPassKey") = TRUE
'function successful
Exit Function
errEnableShift:
'The first part of this error routine creates the "AllowByPassKey
'property if it does not exist.
If Err = conPropNotFound Then
Set prop = db.CreateProperty("AllowByPassKey", _
dbBoolean, True)
db.Properties.Append prop
Resume Next
Else
MsgBox "Function 'ap_DisableShift' did not complete successfully."
Exit Function
End If
End Function
Use the following:
Function DatabaseDisableShift()
On Error GoTo FunctionError
Dim CurrentDatabase As DAO.Database, DatabaseProperty As DAO.Property
Const PropertyNotFound = 3270
Set CurrentDatabase = CurrentDb()
CurrentDatabase.Properties("AllowByPassKey") = False
Exit Function
FunctionError:
If Err = PropertyNotFound Then
Set DatabaseProperty = _
CurrentDatabase.CreateProperty("AllowByPassKey", dbBoolean, False)
'Change to True, to enable shift.
CurrentDatabase.Properties.Append DatabaseProperty
Resume Next
Else
MsgBox Err.Description
Exit Function
End If
End Function
I have a program in Microsoft Access. I have VBS script files to automate SAP GUI screens ("transactions"). Using VBA in Access opens these different VBS script files using the Scriptcontrol object and performs a transaction in a SAP system.
Now, sometimes there is an error while running the transaction and then the script stops. I have written the error handler in every VBS script files.
My goal is that if there is an error in the SAP while running .VBS then it should close the active SAP session and store the status information in a string called "ScriptStatus". Then I pull this string to the calling vba back and again run the same .vbs script.
Code in the .VBS
dim ScriptStatus
Function (DoWork)
If Not IsObject(application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = application.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject application, "on"
End If
on error resume Next
'SAP Code
session.findById("wnd[0]").maximize
'Furhter SAP Code
'Change the ScriptStatus to completed
ScriptStatus = "Script Completed"
If Err.Number <> 0 Then
'Change ScriptStatus
ScriptStatus = "Script Error"
'Close SAP Session
session.findById("wnd[0]").Close
End If
End Function
The code in the calling VBA
Sub Foo()
Dim vbsCode As String, result As Variant, script As Object, ScriptInfo As String
ReRunScript:
'// load vbs source
Open "x.vbs" For Input As #1
vbsCode = Input$(LOF(1), 1)
Close #1
On Error GoTo ERR_VBS
Set script = CreateObject("ScriptControl")
script.Language = "VBScript"
script.AddCode vbsCode
result = script.Run("DoWork")
ScriptInfo = script.Eval("ScriptStatus")
If ScriptInfo = "Script Completed" Then
Exit Sub
Elseif ScriptInfo = "Script Error" Then
Goto ReRunScript
End if
ERR_VBS:
MsgBox Err.Description
MsgBox script.Eval("ScriptStatus")
End Sub
Rather than running them via cscript you can execute them directly using the ScriptControl (32 bit only) - this would let you catch the errors directly in Access with a standard On Error (As well as allowing you to capture a return value).
Example .VBS file:
function DoWork
'// do some work
msgbox 1
'// error
x = 100 / 0
DoWork = "OK"
end function
VBA:
Sub Foo()
Dim vbsCode As String, result As Variant
'// load vbs source
Open "x.vbs" For Input As #1
vbsCode = Input$(LOF(1), 1)
Close #1
On Error GoTo ERR_VBS
With CreateObject("ScriptControl")
.Language = "VBScript"
.AddCode vbsCode
result = .Run("DoWork")
End With
Exit Sub
ERR_VBS:
MsgBox Err.Description
End Sub
Edit - To capture your Status variable make it global in the script (declared outside of a sub/function) and use the .Eval() method to read in in VBA.
Example .VBS file:
dim Status
function DoWork
'// do some work
msgbox 1
Status = "Hello World"
'// error
x = 100 / 0
DoWork = "OK"
end function
VBA:
Sub Foo()
Dim vbsCode As String, result As Variant, script As Object
'// load vbs source
Open "x.vbs" For Input As #1
vbsCode = Input$(LOF(1), 1)
Close #1
On Error GoTo ERR_VBS
Set script = CreateObject("ScriptControl")
script.Language = "VBScript"
script.AddCode vbsCode
result = script.Run("DoWork")
Exit Sub
ERR_VBS:
MsgBox Err.Description
'// read VBS global
MsgBox script.Eval("Status")
End Sub
This is a project I inherited. I noticed that sometimes it doesn't log errors.
This routine raises an error so that it can log it along with the rest of the message.
But it never returns to the error point and actually logs the error.
I can see what it is supposed to do, but I can't see how to get it to work.
Public Sub PostErrorToLog(lngErrID As Long, strContext As String, Optional strEvent As String)
On Error GoTo ErrHandler:
Dim strErrEvent As String
Dim rst As New ADODB.Recordset
Dim pass As Integer
pass = 0
'Capture event description by triggering the error.
Err.Raise lngErrID ' It gets to here, then jumps
'Use AddNew because SQL may be added into strEvent, causing objSQL.RunADO() to fail.
Set rst = objSQL.GetRST("PostErrorToLog()", "[System Log]", , , adCmdTable)
rst.AddNew ' Never gets here.
rst![UID] = strCurrUID
rst![ErrorID] = lngErrID
rst![Source] = strContext
rst![Event] = ConcatenateStrings(strErrEvent, strEvent, " ")
rst.Update
rst.Close
FlushLog "Error"
Exit Sub
ErrHandler:
strErrEvent = Err.Description
pass = pass + 1
If pass > 2 Then ' Seems like pass is always going to be 1
Resume Next
End If ' It gets to here and exits the routine.
End Sub
I need to write code that goes to a specific path and imports data from it,
then goes to another path and do the same.
I need that if path num 1 does not exist, it will jump direct to path num 2.
I wrote a sub for each path. there is a way to do something like:
if error goto sub ___ ?
Thanks in advance
Not directly, but you can do something like
On Error Goto error_sub1
and at the bottom of your function, write
error_sub1:
'ToDo - put your calling code here.
Elsewhere in you function you can switch the error handler to a different label:
On Error Goto error_sub2
and so on.
Try this:
Sub testSO()
On Error GoTo err
I=5/0
Exit Sub
err:
<your sub procedure here>
End Sub
Remember to include Exit Sub or else it will still run even without error!
Would it not be better to avoid the error in the first place and check whether the file exists before attempting to open it?
Sub Test()
Dim sFile1 As String
Dim sFile2 As String
Dim wrkBk As Workbook
On Error GoTo Error_Handler
sFile1 = "C:\Users\Desktop\MyFile1.xls"
sFile2 = "C:\Users\Desktop\MyFile2.xls"
If FileExists(sFile1) Then
Set wrkBk = Workbooks.Open(sFile1)
ElseIf FileExists(sFile2) Then
Set wrkBk = Workbooks.Open(sFile2)
Else
Err.Raise 513, , "File Not Found."
End If
wrkBk.Worksheets(1).Range("A1") = "Opened this file."
On Error GoTo 0
Fast_Exit:
'Any tidying up that needs doing.
Exit Sub
Error_Handler:
MsgBox Err.Description, vbExclamation + vbOKCancel, _
"Error: " & CStr(Err.Number)
Err.Clear
Resume Fast_Exit
End Sub
Public Function FileExists(ByVal FileName As String) As Boolean
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
FileExists = oFSO.FileExists(FileName)
End Function
I want to catch my error handling statement only once, if it fails again, resume next. I'm not sure how to achieve that but so far i'm able to rerun the code if it keeps on failing. Reason is i don't want to get stuck in a loop if the file never exist. Here's what i have:
....some code
TryAgain:
....
....
If Not FileExists("C:\" & FileName) Then
GoTo TryAgain >>> Only want to run this once if it fails again continue on down with the next section of codes.
End If
....next code stuff....
.....Dim blnRetry as Boolean
blnRetry =true
TryAgain:
....
....
If Not FileExists("C:\" & FileName) Then
if blnRetry then
blnRetry=false
GoTo TryAgain
end if
End If
My rule about GoTo is that I only use it in an On Error statement. Consider using a Do..Loop and a counter. Here's an example
Sub Test()
Dim sFile As String
Dim lTryCnt As Long
Const lMAXTRYCNT As Long = 10
Do
sFile = InputBox("Enter file name")
lTryCnt = lTryCnt + 1
Loop Until sFile = "False" Or Len(Dir("C:\" & sFile)) > 0 Or lTryCnt >= lMAXTRYCNT
Debug.Print sFile, lTryCnt
End Sub
sfile = "False" is if the user clicks Cancel on the inputbox. Len(Dir()) returns a zero length string if the file doesn't exist.