[VB6]Searching an ActiveX/COM object for a method

This article was first posted by me on StackOverflow in response to my own question, "How do I search an ActiveX/COM object for a method?". This article is an edited version of the original.

"After Googling around not quite finding what I wanted, I remembered the Edanmo site which got me thinking about TLBINF32.DLL, downloading Microsoft's TLBINF32.CHM and reading up on GetMembersWithSubStringEx.

Below is the implementation of it (done in VB6 with a reference to TLBINF32.DLL), some demo VBScript and output, and the wrapping of that functionality in some VBA.

Public Function SearchTLIMethodsAndProperties(sTypelib As Variant, sSymbol As Variant) As Variant Dim SI As SearchItem Dim aResults As Variant Dim bFound as boolean Dim Groups(1) As InvokeKinds Groups(0) = INVOKE_FUNC Or INVOKE_PROPERTYGET Or _ INVOKE_PROPERTYPUT Or INVOKE_PROPERTYPUTREF ReDim aResults(0) bFound = False With TypeLibInfoFromFile(sTypelib) .SearchDefault = tliStClasses Or tliStEvents For Each SI In .GetMembersWithSubStringEx(sSymbol, Groups) bFound = True arr.AAdd_PostIncrement aResults, SI.Name Next End With if bFound then ReDim Preserve aResults(UBound(aResults) - 1) end if SearchTLIMethodsAndProperties = aResults End Function

VBScript demo. The above code was included in my StdLib DLL in the Registry coclass.

Dim O, R Set O = CreateObject("Std.Registry") Set R = CreateObject("Std.Arrays") WScript.Echo R.ShowStructure( O.SearchTLIMethodsAndProperties( "MSSCRIPT.OCX",""))

Output from the demo (script was run in SciTE).

>cscript "C:\foo\foo.vbs" {Add,AddCode,AddObject,AllowUI,Clear,CodeObject,Column,Count,Description,Error,Eval,ExecuteStatement,HasReturnValue,HelpContext,HelpFile,Item,Language,Line,Modules,Name,NumArgs,Number,Procedures,Reset,Run,SitehWnd,Source,State,Text,Timeout,UseSafeSubset} >Exit code: 0

Finally, the VBA code. A cell has a symbol in it and this routine finds it or returns an error string. (reg. in this case refers to the Registry coclass in the StdLib.DLL)

Public Function LookupSymbol(sLib As String, sSym As String) As String Dim aRes As Variant aRes = reg.SearchTLIMethodsAndProperties(sLib, sSym) Dim i As Integer LookupSymbol = "!!NotFound!!" For i = 0 To UBound(aRes) If LCase$(aRes(i)) = LCase$(sSym) Then LookupSymbol = sSym Exit For End If Next End Function

Hmm ... no error checking. Should fix that.

© Copyright Bruce M. Axtens, 2009