So I have this code in VBA that uses a third party COM class to add a record to a database
Function AddPatientToDolphin(ID As String, LastName As String, FirstName As String)
On Error GoTo CatchError
Dim Plst As DOLDBSVRLib.DolphinPatients
Dim Patient As DOLDBSVRLib.DolphinPatient
Set Plst = New DOLDBSVRLib.DolphinPatients
Set Patient = New DOLDBSVRLib.DolphinPatient
Patient.patientID = ID
Patient.LastName = LastName
Patient.FirstName = FirstName
Plst.AddPatient Patient
Set Plst = Nothing
Set Patient = Nothing
NormalExit:
Exit Function
CatchError:
MsgBox (Err.Description )
GoTo NormalExit
End Function
The code is fine and it works correctly, except when the ID is already present in the database, then the record will not be added but no error is raised!
in the documentation of the 3rd party dll, there is this instruction regarding this method
HRESULT AddPatient(LPDISPATCH newPatient)
Add a patient represented by the patient object submitted.
After some research, I learned that every method in a COM class returns a value called Hresult. This is supposed to be 0 when everything runs correctly, and not 0 otherwise. My question is how could I pick up and test this value in VBA??
HRESULT AddPatient(LPDISPATCH newPatient)
This function is declared that so that it has no returncode in VBA. If the returncode is a HRESULT error code, VBA translates this into an exception and sets the code into the Err object.
If the function reacts normal and returns and doesn't show any fault, than the only way is to check if the ID exists. But this is a race condition. Another user may execute the same code.
There is no real answer for this kind of interface if it behaves in this way.
Or contact the guy who is responsable for this COM interface.
You will have to inspect the return value of the external function. To catch it in a variable:
Dim RetVal As Long
RetVal = Plst.AddPatient(Patient)
Then, compare to 0 and eventually display an error message:
If RetVal <> 0 Then
MsgBox "Something went wrong"
End If
Added:
Ok, the call as a function is not allowed in this case, so try this:
Plst.AddPatient Patient
If Err.LastDLLError <> 0 Then
MsgBox "Something went wrong"
End If
Related
I'm calling a C# WebService method called getInterventions() on a VBA Access 2003 application through a custom DLL. The signature of this method is as follows:
List<Item> getInterventions(string, string, string, string, string, string)
Item is a custom defined class.
When I try to retrieve the result of getInterventions() on VBA Access code, it pops a VBA Runtime error 242 : object required
The following is my code:
Dim WsObject As Object
Dim result As Object
Set WsObject = CreateObject("Namespace1.Path.To.Class") 'This isn't the actual DLL path as I cannot share that
'Set result = WsObject .getSingleIntervention("123, "0", "123456789", "") ' this works
Set result = WsObject .getInterventions("", "", "123456789", "", "", "") 'this doesn't work
If result Is Nothing Then
'do some stuff
Else
'do some other stuff
End If
getSingleIntervention() is a similar method which returns a single object rather than a list of objects. Returning the result of this method works without issues (see commented line). This proves that both the WS & DLL calls work. This method is defined as follows:
Item getSingleIntervention(string, string, string, string)
I have tested calling getInterventions() directly from the C# code via Visual Studio 2015 with the same parameters I'm passing in my VBA code and it worked. This proves that it's not an issue with parameters or the method content.
My conclusion:
I am guessing it's something to do with the fact that I can't simply store a C# List of objects into a VBA Object.
Any help would be appreciated, thank you.
Please, automatically add mscorlib.tlb reference, running the next code:
Sub addMscorlibRef() 'necessary to use ArrayList
'Add a reference to 'Mscorlib.dll':
'In case of error ('Programmatic access to Visual Basic Project not trusted'):
'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
' check "Trust access to the VBA project object model"
If dir("C:\Windows\Microsoft.NET\Framework64\v4.0.30319", vbDirectory) = "" Then _
MsgBox "You need to install ""Framework version 3.5"".": Exit Sub
On Error Resume Next
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\Microsoft.NET\Framework64\v4.0.30319\mscorlib.tlb"
If err.Number = 32813 Then
err.Clear: On Error GoTo 0
MsgBox "The reference already exists...": Exit Sub
Else
On Error GoTo 0
MsgBox """Mscorlib"" reference added successfully..."
End If
End Sub
Then try declaring Dim result As ArrayList.
The ArrayList is the same one that is used in C#. Then, adapt the dll to use such an object. As you deduced, no any object able to be used in VBA can receive the C# list object content.
We all know there can only ever be one error object in VBA.
While helping a co-worker with error handling and why he shouldn't use On Error Resume Next I had an idea:
Store the error object somewhere to later reference back to it.
Consider this piece of test code:
Sub Test()
Dim t As ErrObject
On Error Resume Next
Err.Raise 1
Set t = Err
On Error GoTo 0
Debug.Print t.Number
On Error Resume Next
Err.Raise 1
Debug.Print t.Number
End Sub
It will print 0 to the immediate window because On Error GoTo 0 resets the error object and then prints 1 since it still holds a reference to the only error object (?).
If we create a new class and give it some properties pertaining to the ErrObject like so:
(TestClass)
Option Explicit
Public oError As ErrObject
Private Sub Class_Initialize(): End Sub
Private Sub Class_Terminate()
If Not oError Is Nothing Then Set oError = Nothing
End Sub
Public Property Get Error()
Error = oError
End Property
Public Property Set Error(ByVal ErrorObject As ErrObject)
Set oError = ErrorObject
End Property
And create our instance like this:
Sub Test2()
Dim t As TestClass
On Error Resume Next
Set t = New TestClass
Err.Raise 1
Set t.Error = Err
On Error GoTo 0
Debug.Print t.oError.Number
On Error Resume Next
Err.Raise 1
Debug.Print t.oError.Number
End Sub
We still get 0 and 1 as output respectively.
This bringst me to my question: What is the use of declaring a variable as ErrObject when we cannot create a new object itself but it simply becomes another pointer to the only error object in VBA?
None whatsoever.
Err is often treated as some kind of global ErrObject instance, but the truth is, it's a function that returns one - as revealed in the object browser:
And that function is implemented in such a way, that you always get the same object.
Objects need to expose an interface to be usable, and so the object returned by the Err function exposes that of the ErrObject class - it doesn't mean the ErrObject class exists so that it can be instantiated or encapsulated by user code: it merely provides an interface to access the properties of the current run-time error state.
When you encapsulate an ErrObject like you did, you're essentially just giving yourself another way (besides the Err function) to access the ErrObject instance - but it's still the exact same object holding the properties of the current run-time error state.
And when an object's properties change, your encapsulated copy that points to that object is going to start reporting the new values, and the old ones you meant to "remember" are overwritten.
Note that this is true for any object, not just ErrObject.
Say I have a class that does what you're doing with the ErrObject reference, but with a Collection:
Private coll As Collection
Public Property Set InternalCollection(ByVal c As Collection)
Set coll = c
End Property
Public Property Get InternalCollection() As Collection
Set InternalCollection = coll
End Property
If I make an instance of that class (let's call it Class1) and assign c to its InternalCollection, and then add items to c...
Dim c As Collection
Set c = New Collection
With New Class1
Set .InternalCollection = c
c.Add 42
.InternalCollection.Add 42
Debug.Print .InternalCollection.Count
End With
The output is 2, because c and InternalCollection (/the encapsuated coll reference) are the very same object, and that's what's happening with your encapsulated ErrObject.
The solution is to not encapsulate the ErrObject itself, but rather pull its values into backing fields for get-only properties that encapsulate the state of the ErrObject:
Private errNumber As Long
Private errDescription As String
'...
Public Sub SetErrorInfo() 'note: an ErrObject argument would be redundant!
With Err
errNumber = .Number
errDescription = .Description
'...
End With
End Sub
Public Property Get Number() As Long
Number = errNumber
End Property
Public Property Get Description() As String
Description = errDescription
End Property
'...
Now, whether that's useful is up for debate - IMO if the state is consumed at a moment where the global error state already contains the same information, there's no need to do this.
The class could pretty easily be [ab]used as a return type for a Function that returns Nothing to indicate success, and the encapsulated error state in case of failure - the problem is that the language is designed around raising errors rather than returning them; it's too easy to "fire-and-forget" such a function without verifying its return value, and since at the call site the actual runtime error state isn't going to trip an On Error statement, carrying error state as program data isn't idiomatic, it makes a "surprising" API that can easily result in code that ends up ignoring all errors.
Idiomatic error handling deals with the global runtime error state as soon as possible, and either recovers in the same scope, or lets the error state bubble up the call stack to where it can be handled. And until the error is handled, the ErrObject state is accessible through the global Err function.
I am using bool method with Visual Studio 2015 and SQL Server 2005.
When I am passing correct details and click loginButton, the code always returns false from the stored procedure.
This is my stored procedure in SQL Server 2005:
ALTER PROCEDURE [dbo].[UserCheckLoginDetails]
(#IsLoginIdCorrect BIT OUTPUT,
#IsPasswordCorrect BIT OUTPUT,
#LoginID NVARCHAR(200),
#Password NVARCHAR(20)
)
AS
BEGIN
SET #IsLoginIdCorrect = 0
SET #IsPasswordCorrect = 0
IF EXISTS (SELECT * FROM UserInfo
WHERE loginid = #LoginID AND password = #Password)
BEGIN
SET #IsLoginIdCorrect = 1
SET #IsPasswordCorrect = 1
END
ELSE
IF EXISTS (SELECT * FROM UserInfo WHERE loginid = #LoginID)
BEGIN
SET #IsLoginIdCorrect = 1
END
END
This is my method returning True or False:
Private Sub GetIsUserLoginCorrect(IsLoginIdCorrect As Boolean, IsPasswordCorrect As Boolean)
Using Conn As New SqlConnection(_SqlCon)
Using cmd As New SqlCommand("UserCheckLoginDetails", Conn)
cmd.CommandType = CommandType.StoredProcedure
Conn.Open()
'OutPut Parameters
cmd.Parameters.Add("#IsLoginIdCorrect", SqlDbType.Bit).Direction = ParameterDirection.Output
cmd.Parameters.Add("#IsPasswordCorrect", SqlDbType.Bit).Direction = ParameterDirection.Output
'InPut Parameters
cmd.Parameters.AddWithValue("#LoginID", LoginIDTextBox.Text)
cmd.Parameters.AddWithValue("#Password", PasswordTextBox.Text)
cmd.ExecuteNonQuery()
' Assign Parameters
IsLoginIdCorrect = Convert.ToBoolean(cmd.Parameters("#IsLoginIdCorrect").Value)
IsPasswordCorrect = Convert.ToBoolean(cmd.Parameters("#IsPasswordCorrect").Value)
End Using
End Using
End Sub
This is the Login button click event handler, even when I provide the correct values, it still always returns false:
Private Sub LoginButton_Click(sender As Object, e As EventArgs) Handles LoginButton.Click
Try
Dim IsLoginIdCorrect, IsPasswordCorrect As Boolean
GetIsUserLoginCorrect(IsLoginIdCorrect, IsPasswordCorrect)
If IsLoginIdCorrect And IsPasswordCorrect = True Then
Me.Hide()
' User Information
DeshBoard.MainUserIdLabel.Text = Me.MainUserIdLabel.Text
DeshBoard.UserNameLabel.Text = Me.UserNameLabel.Text
DeshBoard.UserLoginIdLabel.Text = Me.UserLoginIdLabel.Text
DeshBoard.UserLevelLabel.Text = Me.UserLevelLabel.Text
'Organanization Information
DeshBoard.MainOrgIDLabel.Text = Me.MainOrgIDLabel.Text
DeshBoard.OrgNameLabel.Text = Me.OrgNameLabel.Text
DeshBoard.OrgTelLabel.Text = Me.OrgTelLabel.Text
DeshBoard.OrgEmailLabel.Text = Me.OrgEmailLabel.Text
DeshBoard.OrgAddressLabel.Text = Me.OrgAddressLabel.Text
DeshBoard.Show()
Else
If IsLoginIdCorrect = False Then
MessageBox.Show("Login ID is not correct...!!", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
LoginIDTextBox.Clear()
PasswordTextBox.Clear()
LoginIDTextBox.Focus()
Else
MessageBox.Show("Password ID is not correct...!!", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
PasswordTextBox.Clear()
PasswordTextBox.Focus()
End If
End If
Catch ex As ApplicationException
MessageBox.Show("Error: " + ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Thank you very much.
You need to add ByRef to both arguments in Sub GetIsUserLoginCorrect().
To demonstrate, try the following with and without ByRef.
Private Sub ChangeBoolean(ByRef TorF As Boolean)
TorF = True
End Sub
Private Sub OPCode2()
Dim TorF As Boolean
ChangeBoolean(TorF)
Debug.Print(TorF.ToString) ' Result False without ByRef in ChangeBoolean
'When ByRef is added result is True
End Sub
First off, a method can refer to either a sub or a function. A sub is a method that performs an action. A function is a method that calculates or retrieves one or more values.
A sub should not be called Getxxx, because its primary purpose should not be returning a value.
A function should be used to return values. Since you are trying to retrieve multiple values, if you were using 2017 I would suggest returning a named tuple with your two values, since you aren’t I would create an object that has the values and return that.
On a totally different note, you really can’t tell the difference between right user wrong password and wrong user right password and wrong user wrong password - so you shouldn’t tell someone you can. You just say login unsuccessful login, or invalid username/password combination.
There's a lot wrong with your code.
Firstly, why are you using so much of SQL code ? Correct me if i am wrong : You are trying to build a log in system. So much of SQL code or even the stored procedure is worthless here. You can simply write the SQL statements in your code by using the SqlCommand class. Even though you are using the ALTER PROCEDURE statement, i can surely say that things can be simplified here.
You are also using the Me keyword. It's not C# where the use of this(same as Me in VB.Net) becomes compulsory. I assume it's a Windows Forms Application and if that's so, then using Me keyword to access it's child elements wouldn't result in any different if it's not used at all.
The next worth mentioning issues is your Name Conventions. Most or should i say all of your variables have the same name. For example : IsLoginIdCorrect - used both as a parameter of a method and also a variable inside a method.
The next issues is in these two lies :
Dim IsLoginIdCorrect, IsPasswordCorrect As Boolean
GetIsUserLoginCorrect(IsLoginIdCorrect, IsPasswordCorrect)
You are passing the boolean variables before they have been assigned any value. You are lucky it's not C# or this wouldn't even compile. Passing the boolean variables without assigning any value will, by default, set their values to False. So, literally, you are always passing the same value in which case, the outcome will always be the same.
The next issue is in your If statement inside your LoginButton_Click method aka LoginButton's click event handler's method :
If IsLoginIdCorrect And IsPasswordCorrect = True Then
The if statements, if described in simple words, means : If IsLoginIdCorrect and IsPasswordCorrect are true, then proceed.... So, in this case, IsPasswordCorrect = True doesn't affect much. However, this is not the best practice too. You should better follow the following coding rule while using If statements:
If (IsLoginIdCorrect = True AndAlso IsPasswordCorrect = True) Then
AndAlso operators evaluates each side just like the And operator. The difference is that it would return False if the left side(IsLoginIdCorrect, in this case) returns False.
The next issues is the usage of ApplicationException. I don't understand why, in this era, you are using that class! This class is usually used to derive from and create exceptions. You can simply use Exception instead of ApplicationException.
Your Try-Catch block seems not useful as well. All of your codes inside the LoginButton_Click are in If conditions and they perform very basic operation. It is unlikely to ever throw any exception at all.
Your logics, for most part, are illogical(sorry to put it this way). In your GetIsUserLoginCorrect method, you are setting IsLoginIdCorrect and IsPasswordCorrect to either true or false but it wouldn't matter because they are parameters of the method itself. So even if you set their values, they will be reset when you call the method again. The reason why ByRef (according to Mary's answer) works is because ByRef, in short, means that you are pointing to original variable that you passed(not it's copy).
And finally, the solution you are looking for....
Even though i see you have marked Mary's answer as the answer, i would like to help you out a bit as-well.
Firstly, get rid of the stored procedure if possible and also if you are not using it anywhere else. I see you are using the If Exist condition inside your SQL queries. This is actually a nice move because according to performance reports, checking if data exists in a database/table using IF EXISTS yields the fastest output. So bravo for that one. But if you follow my advice and want to ditch the stored procedure, then you need to get rid of the IF EXISTS statement as well. Rather, you can simply use the SELECT statement itself, use the ExecuteScalar method of the SqlCommand class, convert it's value to Integer and check if the value of the Integer is 1 or not.
Example :
Dim cmd = New SqlCommand("SELECT COUNT(*) FROM UserInfo
WHERE loginid = #LoginID AND password = #Password")
Dim Exists = Convert.ToInt32(cmd.ExecuteScalar)
If Exists = 1 Then
''Code if data exists
End if
Note that i have used Convert.ToInt32 here. This will prevent null-reference exception as when ExecuteScalar returns Null, it will be converted to 0 integer value.
Also, why are you using GetIsUserLoginCorrect as method ? You can simply use it as a function and return required values. As you are returning multiple values, you can easily use the Tuple type as your function's type:
Private Function GetIsUserLoginCorrect(IsLoginIdCorrect As Boolean, IsPasswordCorrect As Boolean) As Tuple(of Boolean, Boolean)
....
....
return Tuple.Create(IsLoginIdCorrect, IsPasswordCorrect)
End Sub
Usage
Dim IsLoginCorrect = GetIsUserLoginCorrect(first_boolean_variable,second_boolean_variable).Item1
Dim IsPasswordCorrect = GetIsUserLoginCorrect(first_boolean_variable,second_boolean_variable).Item2
One last thing. As you are showing DeshBoard form after hiding the main form, make sure to call MainForm.Close on the Dashboard form's Closing/Closed event. This will ensure the application's exit(unless you have other plans for the main form, of course).
Hope this answer helps you.
I have made an out-of-process COM server (C++) that is called from VBA.
For an unknown reason when I call it multiple times (at least two times in the same sub) I'm only able to call it using Dim xx As New xxx.
When I try to call it using Dim xxx As xxx and then Set xx = new xxx , my com server raises a violation reading exception and VBA returns the error code 800706BE.
The following code does work (pseudo code - I removed the irrelevant part). Note that the 'Main' sub call the 'aux' function and that both the Sub and the 'aux' function call my COM server (two different classes).
Function aux() As Double()
Dim com As New COMServer.classe2
Dim Returns() As Double
Returns = com.Method2 'actual call to the COM Server
aux = Returns
End Function
Sub Main()
Dim Resultat() As Double
Dim com1 As New COMServer.classe1
Dim Returns() As Double
Returns = aux ' call Function aux
Resultat = com1.Method1(Returns) 'actual call to the COM Server
End Sub
The following does not work :
Function aux() As Double()
Dim com As COMServer.classe2
Set com = New COMServer.classe2
Dim Returns() As Double
Returns = com.Method2 'actual call to the COM Server
aux = Returns
End Function
Sub Main()
Dim Resultat() As Double
Dim com1 As COMServer.classe1
Set com1 = New COMServer.classe1
Dim Returns() As Double
Returns = aux ' call Function aux
Resultat = com1.Method1(Returns) 'a violation reading (c++) Exception is thrown here
End Sub
Can someone explain me why my code only works in the first case ?
Also note that if I only call the server once in the sub (no call to aux), then both methods ( Dim as New and Dim/Set ) work.
EDIT
I have noticed that in case 1 (the case that works) : my server automatically start and stop two times consecutively (seen in the Windows Task Manager ).
Whereas in second case (the buggy one) : my server start only once - didn't stop and raise the error.
Now I have just modified the second case in the following manner and the exception disappears :
Sub Main()
Dim Resultat() As Double
Dim Returns() As Double
Returns = aux ' call Function aux
Dim com1 As COMServer.classe1
Set com1 = New COMServer.classe1
Resultat = com1.Method1(Returns) 'no more Exception
End Sub
The only difference is that I set my server just before to call it (instead to initialize it before to call my 'aux" function).
Does it makes sense to someone ?
Dim statements aren't executable. Set statements are.
When you do Dim foo As New Bar you're creating an auto-instantiated object variable, which incurs a bit of overhead in the VBA runtime (every call against it validates whether there's a valid object reference).
This is how auto-instantiated objects bite:
Dim foo As New Collection
Set foo = Nothing
foo.Add 42 'runtime error 91? nope.
Debug.Print foo.Count ' prints 1
Set foo = Nothing
Debug.Print foo.Count ' runtime error 91? nope. prints 0
So As New makes VBA go out of its way to ensure there's always a valid object reference for that pointer, no matter what. Every member call on object variables declared As New is valid: VBA will create a new instance before making the member call if the reference points to Nothing - that's the overhead I mentioned earlier, and contradicts LS_dev's answer. Auto-instantiated object variables aren't "only instantiated on first member call" - they're instantiated whenever they need to be.
The answer is likely in your C++ code, not in the client VBA code. Something is wrong with how you're cleaning things up, there's loose ends somewhere - using As New to work around a sloppy COM server doesn't strike me as a good idea (As New should generally be avoided, as a matter of fact, for the unintuitive behavior depicted above).
Problem may be in sequence of call. From my experience, objects declare with As New are only instantiated in first member call, while Set ... = New instantiate object immediately.
Said so, in first case classe2 is created before classe1 which is only created when you call com1.Method1.
In second case, classe1 is created in Set, before classe2.
taking this into account, it seams your COM code somehow create a memory violation if classe1 is created before classe2.
Say you have one slide with one chart on it, and you run this code(in a version of Office later than 2007):
Dim pptWorkbook As Object
Dim result As Object
Set pptWorkbook = ActivePresentation.slides(1).Shapes(1).Chart.ChartData.Workbook
Set result = pptWorkbook.ContentTypeProperties
You will generate an error:
Application-defined or object-defined error
I believe this is because "Smart tags are deprecated in Office 2010."(Source), Generally to avoiding this sort of issue from throwing an error and exiting your VBA you can take one of two different approaches:
//Method 1
If OfficeVersion <= 2007
Set result = pptWorkbook.ContentTypeProperties
//Method 2
On Error Resume Next // or GOTO error handler
Set result = pptWorkbook.ContentTypeProperties
Method one requires that you know the specific reason why the property would cause an error, which is easy in this case but may not be as easy with other properties. Method two requires that you use some form of error handling to deal with the error AFTER the fact, my understanding of most other Microsoft languages is that is typically discouraged(example, another example). Is this standard practice in VBA?
In VBA, is there any other way to determine whether a property of an object would throw an error if invoked, BEFORE invoking that property, and without knowing the specifics of that invoked property?
What I like to do for this situation is create a separate function that checks if the property exists and returns a Boolean. In this case it would look something like this:
Public Function CheckIfExists(targetObj As Object) As Boolean
Dim testObj As Object
On Error GoTo failedTest:
Set testObj = targetObj.ContentTypeProperties
CheckIfExists = True
Exit Function
failedTest:
CheckIfExists = False
End Function
Which would return false if that property causes an error and true if not-
Then modify your sub to be:
Public Sub FooSub()
Dim pptWorkbook As Object
Dim result As Object
Set pptWorkbook = ActivePresentation.slides(1).Shapes(1).Chart.ChartData.Workbook
If CheckIfExists(pptWorkbook) Then
Set result = pptWorkbook.ContentTypeProperties
End If
... rest of your code or appropriate error handling...
Hope this helps,
TheSilkCode