Following script runs successfully in excel but throws syntax error when executed through .vbs file or in winautomation. I'm new to vb, please help.
Sub Test()
sUser = "TheUserName"
sDN = "uid=" & sUser & ",o=users,dc=MyDomain,dc=it"
sRoot = "LDAP://MyLDAPServer/o=users,dc=MyDomain,dc=it"
Dim oDS: Set oDS = GetObject("LDAP:")
On Error GoTo AuthError
Dim oAuth: Set oAuth = oDS.OpenDSObject(sRoot, sDN, "ThePassword", &H200)
On Error GoTo 0
MsgBox "Login Successful"
Exit Sub
AuthError:
If Err.Number = -2147023570 Then
MsgBox "Wrong Username or password !!!"
End If
On Error GoTo 0
End Sub
From Handling Errors in VBScript.
There is little difference between the methods used in Visual Basic and those used with VBScript. The primary difference is that VBScript does not support the concept of error handling by continuing execution at a label. In other words, you cannot use On Error GoTo in VBScript. Instead, use On Error Resume Next and then check both Err.Number and the Count property of the Errors collection, as shown in the following example: (example not provided here - use link for example)
So you will require your own error handling code section.
On Error Resume Next
Dim oAuth: Set oAuth = oDS.OpenDSObject(sRoot, sDN, "ThePassword", &H200)
Select Case Err.Number
Case 0:
'ERROR_SUCCESS - do nothing
Case -2147023570
MsgBox Err.Number & ": " & Err.Description &Chr(10) & "Wrong Username or password !!!"
Err.Clear
Exit Sub
Case Else
'deal with other errors
MsgBox Err.Number & ": " & Err.Description
Err.Clear
Exit Sub
End Select
More on getting error information at Information.Err Method.
Related
I am looking for a way to open the Import XML option (highlighted below) through a macro command...
So far, I have tried using Application.SendKeys ("%lt") - it works, but only when one has enabled the Developer tab in the ribbon - and sadly, a lot of my users won't have the tab enabled. So I thought If it's possible to toggle this checkbox - (File >> Excel Options >> Show Developer Tab)
I'll just make the Developer tab visible in my user's Excel, and then use Sendkeys. Or, if this isn't possible, Is there any way I could invoke the Import XML option by any other means in Macro? Invoking the Import XML option is the only reason I am doing all this. Kindly guide... Thanks! :)
You can activate (mode=1) or deactivate (mode=0) the developer tab by changing the DeveloperTools option in the registry.
Sub Test_DeveloperTab()
Call setDeveloperTab(1)
End Sub
Sub setDeveloperTab(ByVal mode As Integer)
Dim regKey As String
regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Excel\options\DeveloperTools"
On Error GoTo errHandler
' If value is equal to existing or different from 0 or 1 then exit
Select Case Registry_KeyExists(regKey)
Case 0: If mode = 0 Then Exit Sub
Case 1: If mode = 1 Then Exit Sub
Case Else: Exit Sub
End Select
' Late Binding
Dim oShell As Object: Set oShell = CreateObject("Wscript.Shell")
If (mode <> 0 And mode <> 1) Then Exit Sub
' Developer Tab: Activate \\ Deactivate
oShell.RegWrite regKey, mode, "REG_DWORD"
exitRoutine:
Exit Sub
errHandler:
Debug.Print Now() & "; " & Err.Number & "; " & Err.Source & "; " & Err.Description
Resume exitRoutine
End Sub
Function Registry_KeyExists(ByVal regKey$) As Variant
' Check if registry key exists
On Error GoTo errHandler
Dim wsh As Object: Set wsh = CreateObject("WScript.Shell")
Registry_KeyExists = wsh.RegRead(regKey)
Exit Function
errHandler:
Err.Raise Err.Number, "Registry_KeyExists", Err.Description
End Function
I want to use VBScript to catch errors and log them (ie on error "log something") then resume the next line of the script.
For example,
On Error Resume Next
'Do Step 1
'Do Step 2
'Do Step 3
When an error occurs on step 1, I want it to log that error (or perform other custom functions with it) then resume at step 2. Is this possible? and how can I implement it?
EDIT: Can I do something like this?
On Error Resume myErrCatch
'Do step 1
'Do step 2
'Do step 3
myErrCatch:
'log error
Resume Next
VBScript has no notion of throwing or catching exceptions, but the runtime provides a global Err object that contains the results of the last operation performed. You have to explicitly check whether the Err.Number property is non-zero after each operation.
On Error Resume Next
DoStep1
If Err.Number <> 0 Then
WScript.Echo "Error in DoStep1: " & Err.Description
Err.Clear
End If
DoStep2
If Err.Number <> 0 Then
WScript.Echo "Error in DoStop2:" & Err.Description
Err.Clear
End If
'If you no longer want to continue following an error after that block's completed,
'call this.
On Error Goto 0
The "On Error Goto [label]" syntax is supported by Visual Basic and Visual Basic for Applications (VBA), but VBScript doesn't support this language feature so you have to use On Error Resume Next as described above.
Note that On Error Resume Next is not set globally. You can put your unsafe part of code eg into a function, which will interrupted immediately if error occurs, and call this function from sub containing precedent OERN statement.
ErrCatch()
Sub ErrCatch()
Dim Res, CurrentStep
On Error Resume Next
Res = UnSafeCode(20, CurrentStep)
MsgBox "ErrStep " & CurrentStep & vbCrLf & Err.Description
End Sub
Function UnSafeCode(Arg, ErrStep)
ErrStep = 1
UnSafeCode = 1 / (Arg - 10)
ErrStep = 2
UnSafeCode = 1 / (Arg - 20)
ErrStep = 3
UnSafeCode = 1 / (Arg - 30)
ErrStep = 0
End Function
You can regroup your steps functions calls in a facade function :
sub facade()
call step1()
call step2()
call step3()
call step4()
call step5()
end sub
Then, let your error handling be in an upper function that calls the facade :
sub main()
On error resume next
call facade()
If Err.Number <> 0 Then
' MsgBox or whatever. You may want to display or log your error there
msgbox Err.Description
Err.Clear
End If
On Error Goto 0
end sub
Now, let's suppose step3() raises an error. Since facade() doesn't handle errors (there is no On error resume next in facade()), the error will be returned to main() and step4() and step5() won't be executed.
Your error handling is now refactored in 1 code block
I'm exceptionally new to VBScript, so this may not be considered best practice or there may be a reason it shouldn't be done this that way I'm not yet aware of, but this is the solution I came up with to trim down the amount of error logging code in my main code block.
Dim oConn, connStr
Set oConn = Server.CreateObject("ADODB.Connection")
connStr = "Provider=SQLOLEDB;Server=XX;UID=XX;PWD=XX;Databse=XX"
ON ERROR RESUME NEXT
oConn.Open connStr
If err.Number <> 0 Then : showError() : End If
Sub ShowError()
'You could write the error details to the console...
errDetail = "<script>" & _
"console.log('Description: " & err.Description & "');" & _
"console.log('Error number: " & err.Number & "');" & _
"console.log('Error source: " & err.Source & "');" & _
"</script>"
Response.Write(errDetail)
'...you could display the error info directly in the page...
Response.Write("Error Description: " & err.Description)
Response.Write("Error Source: " & err.Source)
Response.Write("Error Number: " & err.Number)
'...or you could execute additional code when an error is thrown...
'Insert error handling code here
err.clear
End Sub
What #cid provided is a great answer. I took the liberty to extend it to next level by adding custom throw handler (like in javascript). Hope someone finds its useful.
option Explicit
Dim ErrorCodes
Set ErrorCodes = CreateObject("Scripting.Dictionary")
ErrorCodes.Add "100", "a should not be 1"
ErrorCodes.Add "110", "a should not be 2 either."
ErrorCodes.Add "120", "a should not be anything at all."
Sub throw(iNum)
Err.Clear
Dim key
key = CStr(iNum)
If ErrorCodes.Exists(key) Then
Err.Description = ErrorCodes(key)
Else
Err.Description = "Error description missing."
End If
Err.Source = "Dummy stage"
Err.Raise iNum 'raise a user-defined error
End Sub
Sub facade(a)
if a=1 then
throw 100
end if
if a = 2 then
throw 110
end if
throw 120
End Sub
Sub Main
on error resume next
facade(3)
if err.number <> 0 then
Wscript.Echo Err.Number, Err.Description
end if
on error goto 0
End Sub
Main
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
I'm Writing a macro program, in that I need to show custom error message if error occurs, I'm facing a problem here. Error handing is working correctly. but the codes in error handling section are executing even though the error not occurred
On Error GoTo ErrorHandling
Source_File_Path = "G:\" & Source_File_name & ".csv"
Open Source_File_Path For Input As #1
On Error GoTo 0
.
.
.
ErrorHandling:
Worksheets("REPORT_VIEW").Activate
MsgBox "FILE NOT FOUND"
I'm seeing the "FILE NOT FOUND" Error on every time.
Help Me., Cheers...
You need to add an Exit sub statement (or Exit Function if you code is from a function). for instance:
sub MySub()
On Error GoTo ErrorHandling
Source_File_Path = "G:\" & Source_File_name & ".csv"
Open Source_File_Path For Input As #1
On Error GoTo 0
.
.
Exit sub
ErrorHandling:
Worksheets("REPORT_VIEW").Activate
MsgBox "FILE NOT FOUND"
end sub
The below code gives the error Variable is undefined (500) when trying to concatenate the error.no in the echo:
'Raise an error to represent an issue with the main code
err.raise 999
dim error
set error = err
'Call another function that could also throw an error
SendMail "To=me","From=me","Subject=Failure in main code"
'Report both errors
wscript.echo "First problem was - Error code:" & error & vbcrlf & "Subsequent problem was - Error code:" & err
Is it possible to clone the err object?
In addition to Ekkehard.Horner, you can also create a custom error class with the same behaviour as the error object. Because the err object is global, you can load it inside the class without passing it to it in a method.
On error resume Next
a = 1 / 0
Set myErr = new ErrClone
On error goto 0
WScript.Echo myErr
' returns 11, the default property
WScript.Echo myErr.Number & vbTab & myErr.Description & vbTab & myErr.Source
' returns 11 Division by zero Microsoft VBScript runtime error
Class ErrClone
private description_, number_, source_
Public Sub Class_Initialize
description_ = Err.Description
number_ = Err.Number
source_ = Err.Source
End Sub
Public Property Get Description
Description = description_
End Property
Public Default Property Get Number
Number = number_
End Property
Public Property Get Source
Source = source_
End Property
End Class
To copy the properties of the global Err object to a new variable for later use (after the global Err was changed by new catastrophies. .Clear, or "On Error GoTo 0") you should use an array:
>> On Error Resume Next
>> a = 1 / 0
>> Dim aErr : aErr = Array(Err.Number, Err.Description, Err.Source)
>> On Error GoTo 0
>> WScript.Echo Join(aErr, "-")
>>
11-Division by zero-Microsoft VBScript runtime error
because you can't create an empty Err object in VBScript.