I am trying to write a function (TypeNameEx) which will return a string which, using a call to VarType(), effectively identifies the type of a a (variant) variable, eg VarType 2 returns “integer” and VarType 3 returns “Long”.
All is fine until I get to VarType 9 which is an object. I COULD just return “Object” and have done with it but would rather something more specific. To this end, I have been able to work out how to establish if it is a UNO object and return “Object-UNO” but, beyond that, have been unable to make a distinction between one of LO’s built in objects or a user object (as defined in a Class Module). For my own Class Modules, I can give all of my classes a .MyClass property but I cannot do the same for class modules written/supplied by AN Other, is there a way to separate built-in objects from user objects?
I have included my code so far below, it is IsIntrinsicObject which I am stuck on
Function IsIntrinsicObject(ByRef rvarObject As Variant) As Boolean
'Return the result of a test for a property method or name which a built in'
' object will have but a user object will not have.'
'As I understand that there no particular property method or name which is'
' owned by ALL built-in non-UNO objects, this probably boils down ta a '
' large Select Case statement which tests a number of things'
End Function 'IsIntrinsicObject'
Function IsUNOObject(ByRef rvarObject As Variant) As Boolean
Dim varDummy As Variant
On Error Goto ErrorHandler
'If our object DOES have .Dbg_Properties and .Dbg_Methods then'
' it may still be a none-UNO object, if it doesn´t then it '
' will fire error 423 if IS a UNO object and error 91 if it is'
' any other type of object'
'So here´s the belt '
varDummy= rvarObject.Dbg_Properties
'And here´s the braces - less chance of someone else'
' implementing BOTH properties in their own class module than'
' just the one!'
varDummy = rvarObject.Dbg_Methods
'Add in some superglue!'
'-If our object is NOT a UNO object this test will fail with'
' error 438'
varDummy = rvarObject.queryInterface(0)
IsUnoObject = True
On Error Goto 0
Exit Function 'IsUNOObject'
ErrorHandler: 'Function IsUNOObject'
Select Case Err
Case 423
Resume Next
Case 438
Resume Next
Case 91
IsUNOObject = False
Case Else
IsUNOObject = False
End Select 'Err'
On Error Goto 0
End Function 'IsUNOObject'
Function ObjectType(ByRef rvarObject As Variant) As String
Dim strRet As String
If IsUNOObject(rvarObject) _
Then
strRet = "Object-UNO"
Else 'IsUNOObject(rvobject)'
On Error Goto ErrorHandler
strRet = "Object-" & rvarObject.MyClass
On Error Goto 0
End If 'IsUNOObject(rvarObject)'
ObjectType = strRet
Exit Function 'ObjectType'
ErrorHandler: 'Function ObjectType'
On Error Goto 0
If IsIntrinsicObject(rvarObject) _
Then
ObjectType = "Object-Intrinsic"
Else 'IsIntrinsicObject(rvarObject)'
ObjectType = "Object-UnknownUserClass"
End If 'IsIntrinsicObject(rvarObject)'
End Function 'ObjectType'
Function TypeNameEx(ByRef rvarVariable As Variant) As String
Dim lngType As Long
Dim strRet As String
lngType = VarType(rvarVariable)
Select Case lngType
Case 0
strRet = "Empty"
Case 1
strRet = "Null"
Case 2
strRet = "Integer"
Case 3
strRet = "Long"
Case 4
strRet = "Single"
Case 5
strRet = "Double"
Case 6
strRet = "Currency"
Case 7
strRet = "Date"
Case 8
strRet = "String"
Case 9
strRet = ObjectType(rvarVariable)
Case Else
strRet = "Unknown"
End Select 'lngType'
TypeNameEx = strRet
End Function 'TypeNameEx'
