Turn Excel VBA Object Browser into a 4-column long list

R

RomulusMilea

Board Regular
Joined
May 11, 2002
Messages
181
Hello All,

I need an Excel macro that will loop through following object libraries: Excel, Office, stdole, and VBA, then for each library will loop through all object Classes, on each class it will loop through all class members and create a table having following 4 columns: Library, Class, Member and Type, where type can be Function, Constant, Sub, Property, Enum, etc.

Table must start from cell A1 of the Sheet1 tab.

I suppose I need to activate/tick first Microsoft Visual Basic for Applications Extensibility 5.3.

I expect the list will contain thousands of rows, maybe more.

This would basically be an exact replica of Excel Object Browser, but turned into an Excel list. I need it for a personal project.

1711389317660.png


Could anyone please generate the code ? Or is the code available somewhere else ?

Thank you in advance !

Regards,
Romulus.
 
Sort by date Sort by votes
I am still in the process of studying your project/code. And I learn a lot in the process. Thanks for this.
Jaafar Tribak said:
' - Didn't know how to distinguish between Methods and Events.
Click to expand...
Are those actual Events, or just predefined methods to react to the events?
Doesn't the parent class name help for distinguish? It seems (at least at first glance) the events-response methods are members of a class named classnameEvents.
Or am I absolutely wrong?

What is the reason for the inability to open most of the loaded libraries? (in the ComboLibs list) Read-access rights or what?
 
Upvote 0

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Jaafar Tribak said:
' - This project requires a reference to Visual Basic for Applications Extensibility.
Click to expand...
Hello Jaafar,

Thank you a lot for your hard work and passion to provide such an amazing solution. Your effort is really immense, I am truly grateful.

For some reason, my Excel version does not allow me to open the XLSM file you created, external macros are not allowed in the company I work for.

Is there possible for you to share the BAS file ? I guess I can access your solution using BAS file.

Also, do you also intend to include in the huge list the items that are hidden ? If yes, please include them into the Excel macro, the fifth column named Hidden ?, possible values are Yes, or No.

Thank you once again, I am looking forward to see the complete solution, that include the topics you mentioned in your Still to do list.

All the best and my warmest regards,
Romulus Milea.
 
Last edited:
Upvote 0
@bobsan42
Thanks for the interest and for the feedback.
Are those actual Events, or just predefined methods to react to the events?
Doesn't the parent class name help for distinguish? It seems (at least at first glance) the events-response methods are members of a class named classnameEvents.
Click to expand...
Those are virtual functions belonging to the Events Interfaces. The code I posted showed them as Methods.
Fortunately, after some further research, I have figured out how to distinguish between Events and Methods. ITypeInfo::GetImplTypeFlags retrieves the IMPLTYPEFLAGS flags for a given interface. If the IMPLTYPEFLAG_FDEFAULT and IMPLTYPEFLAG_FSOURCE bits are set then it is an event interface.

What is the reason for the inability to open most of the loaded libraries? (in the ComboLibs list) Read-access rights or what?
Click to expand...
No. It is the fact that some type libraries are embedded as a resource inside the exe, dll etc, whereas other type libraries come as separate standalone binary file.
So if the chosen library from the ComboLibs list has no typelibrary embedded in it, then LoadTypeLibEx will fail.

So I have amended the code to make sure that the ComboLibs list contains only dlls which have a tlb embedded in them, otherwise it really would be a stupid waste.

Thanks or raising these very good points.

Updated File Demo:
VBA_Custom_ObjBrowser.xlsm



This is how the form browser now looks and behaves after having solved the above mentioned issues:



For future reference, I will post the new code here later on in case more changes are needed.
 
Last edited:
Upvote 0
RomulusMilea said:
For some reason, my Excel version does not allow me to open the XLSM file you created, external macros are not allowed in the company I work for.
Click to expand...
I don't remember if I had to do it in this particular case, but sometimes the system marks some downloaded files as Blocked, so you may have to Unblock the file from the File Properties system dialog.
 
Upvote 0
bobsan42 said:
I don't remember if I had to do it in this particular case, but sometimes the system marks some downloaded files as Blocked, so you may have to Unblock the file from the File Properties system dialog.
Click to expand...
Yes, I just downloaded the updated workbook and file is marked as blocked. So you must unblock it to be able to use the code inside.
1712235643193.png
 
Upvote 0
I have UnBlocked the file, and then I managed to access the file.

One question to Jaafar: when your solution will be completed, will there be possible to generate in one go the list of all Excel objects, from all libraries, all classes and all class members, hidden and not hidden ? The list will be really long for sure, and it should contain 5 columns: Library name, Class name, Member name, Member type, and Hidden [Yes/No]. Thank you.
 
Upvote 0
@RomulusMilea
One question to Jaafar: when your solution will be completed, will there be possible to generate in one go the list of all Excel objects, from all libraries, all classes and all class members, hidden and not hidden ? The list will be really long for sure, and it should contain 5 columns: Library name, Class name, Member name, Member type, and Hidden [Yes/No]. Thank you.
Click to expand...
Ok- I have added code to the ExportToWorksheet button.

I haven't been able to figure out how to tell if a member is hidden or not.

Items in the list are nested so I have added grouping to the export worksheet for easier use.

Exporting larger typelibs (such as the one in excel.exe) to the worksheet ,may take a little while.

BTW, you can use the ExportTLibToSheet SUB independently of the userform. Just passing to it a valid tlb pathname or a file with an embedded tlb.

File Demo:
VBA_Custom_ObjBrowser.xlsm







1- API code in a Standard Module:
VBA Code: 
'\ This VBA project browses typelibs at runtime via low level vTable calls.

'\ Requiremets:
'\ ===========
'   - This project requires a reference to Visual Basic for Applications Extensibility.
'   - 'Trust access to Visual Basic Project' must also be set.

Option Explicit

Public Enum SEARCH_TARGET
    Class_
    Interface_
    Module_
    Enum_
End Enum

Private Const TKIND_ENUM = 0&
Public Enum TKIND
    EI = TKIND_ENUM
    MI = TKIND_ENUM + 2&  'TKIND_MODULE
    II = TKIND_ENUM + 3&  'TKIND_INTERFACE
    CI = TKIND_ENUM + 5&  'TKIND_COCLASS
    DI = TKIND_ENUM + 4&  'TKIND_DISPATCH
End Enum

Public Enum IMPLTYPEFLAGS
   IMPLTYPEFLAG_FDEFAULT = 1&
   IMPLTYPEFLAG_FSOURCE = 2&
   IMPLTYPEFLAG_FRESTRICTED = 4&
   IMPLTYPEFLAG_FDEFAULTVTABLE = 8&
End Enum

Private Enum VarEnum
    VT_EMPTY = 0&
    VT_NULL = 1&
    VT_I2 = 2&
    VT_I4 = 3&
    VT_R4 = 4&
    VT_R8 = 5&
    VT_CY = 6&
    VT_DATE = 7&
    VT_BSTR = 8&
    VT_DISPATCH = 9&
    VT_ERROR = 10&
    VT_BOOL = 11&
    VT_VARIANT = 12&
    VT_UNKNOWN = 13&
    VT_DECIMAL = 14&
    VT_I1 = 16&
    VT_UI1 = 17&
    VT_UI2 = 18&
    VT_UI4 = 19&
    VT_I8 = 20&
    VT_UI8 = 21&
    VT_INT = 22&
    VT_UINT = 23&
    VT_VOID = 24&
    VT_HRESULT = 25&
    VT_PTR = 26&
    VT_SAFEARRAY = 27&
    VT_CARRAY = 28&
    VT_USERDEFINED = 29&
    VT_LPSTR = 30&
    VT_LPWSTR = 31&
    VT_RECORD = 36&
    VT_FILETIME = 64&
    VT_BLOB = 65&
    VT_STREAM = 66&
    VT_STORAGE = 67&
    VT_STREAMED_OBJECT = 68&
    VT_STORED_OBJECT = 69&
    VT_BLOB_OBJECT = 70&
    VT_CF = 71&
    VT_CLSID = 72&
    VT_BSTR_BLOB = &HFFF&
    VT_VECTOR = &H1000&
    VT_ARRAY = &H2000&
    VT_BYREF = &H4000&
    VT_RESERVED = &H8000&
    VT_ILLEGAL = &HFFFF&
End Enum

#If Win64 Then
    Private Const NULL_PTR = 0^
    Private Const PTR_LEN = 8&
#Else
    Private Const NULL_PTR = 0&
    Private Const PTR_LEN = 4&
#End If

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
    Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As LongPtr)
    Private Declare PtrSafe Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
    Private Declare PtrSafe Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare PtrSafe Function StringFromIID Lib "ole32" (ByRef lpsz As GUID, ByVal rclsid As LongPtr) As Long
    Private Declare PtrSafe Function LoadTypeLibEx Lib "OleAut32" (ByVal szFile As LongPtr, ByVal regkind As Long, ByRef pptlib As IUnknown) As Long
    Private Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr
    Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function GetModuleInformation Lib "psapi.dll" (ByVal hProcess As LongPtr, ByVal hModule As LongPtr, mInfo As MODULEINFO, ByVal cbSize As Long) As Long
    Private Declare PtrSafe Function GetModuleFileNameExW Lib "psapi.dll" (ByVal hProcess As LongPtr, ByVal hModule As LongPtr, ByVal lpFileName As LongPtr, ByVal nSize As Long) As Long
    Private Declare PtrSafe Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As LongPtr, lphModule As LongPtr, ByVal cb As Long, lpcbNeeded As Long) As Long
    Private Declare PtrSafe Function GetModuleBaseNameW Lib "psapi.dll" (ByVal hProcess As LongPtr, ByVal hModule As LongPtr, ByVal lpFileName As LongPtr, ByVal nSize As Long) As Long
    Private Declare PtrSafe Function GetModuleFileNameW Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpFileName As LongPtr, ByVal nSize As Long) As Long
    Private Declare PtrSafe Function GetModuleHandleW Lib "kernel32" (ByVal lpModuleName As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare PtrSafe Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As LongPtr, ByVal lpFileName As String, ByVal nSize As Long) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
    Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As LongPtr)
    Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
    Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare Function StringFromIID Lib "ole32" (ByRef lpsz As GUID, ByVal rclsid As LongPtr) As Long
    Private Declare Function LoadTypeLibEx Lib "OleAut32" (ByVal szFile As LongPtr, ByVal regkind As Long, ByRef pptlib As IUnknown) As Long
    Private Declare Function GetCurrentProcess Lib "kernel32" () As LongPtr
    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As Long
    Private Declare Function GetModuleInformation Lib "psapi.dll" (ByVal hProcess As LongPtr, ByVal hModule As LongPtr, mInfo As MODULEINFO, ByVal cbSize As Long) As Long
    Private Declare Function GetModuleFileNameExW Lib "psapi.dll" (ByVal hProcess As LongPtr, ByVal hModule As LongPtr, ByVal lpFileName As LongPtr, ByVal nSize As Long) As Long
    Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As LongPtr, lphModule As LongPtr, ByVal cb As Long, lpcbNeeded As Long) As Long
    Private Declare Function GetModuleBaseNameW Lib "psapi.dll" (ByVal hProcess As LongPtr, ByVal hModule As LongPtr, ByVal lpFileName As LongPtr, ByVal nSize As Long) As Long
    Private Declare Function GetModuleFileNameW Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpFileName As LongPtr, ByVal nSize As Long) As Long
    Private Declare Function GetModuleHandleW Lib "kernel32" (ByVal lpModuleName As LongPtr) As LongPtr
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As LongPtr, ByVal lpFileName As String, ByVal nSize As Long) As Long
#End If

Public Type FUNC_INFO
    Name As String
    memid As Long
    CallConvention As Long
    funckind As Long
    VTBLOffset As Long
    INVOKEKIND As String
    ParamsCount As Long
    OptParamsCount As Long
    ReturnType As String
End Type

Public Type INTERFACE_INFO
    Ptr As LongPtr
    GUID As String
    LCID As Long
    memidConstructor As Long
    memidDestructor As Long
    Name As String
    MembersCount As Long
    InterfacesCount As Long
    wMajorVerNum As Integer
    wMinorVerNum As Integer
    IMPLTYPEFLAGS As Long
End Type

Public Type SPECIAL_ENUMS
    'Special vba ENUMS not defined in the enumerations module.
    Caption() As String
    Value() As String
End Type

Public Type ENUM_VALS
    Name As String
    Value As String
End Type

Public Type TEXT_STRUCT
    Caption As String
    Value As String
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0& To 7&) As Byte
End Type
  
Private Type LARGE_INT
    LowPart As Long
    HighPart As Long
End Type

Private Type DUMMYUNIONNAME_TYPE
    oInst As Long
    lpvarValue As LongPtr
End Type

Private Type VARDESC
    memid As Long
    lpstrSchema As LongPtr
    DUMMYUNIONNAME As LongPtr
    elemdescVar As Long
    wVarFlags As Long
    varkind As Long
End Type

Private Type TTYPEDESC
    pTypeDesc As LongPtr
    vt As Integer
End Type
  
Private Type TPARAMDESC
    pPARAMDESCEX  As LongPtr
    wParamFlags   As Integer
End Type

Private Type TELEMDESC
    tdesc  As TTYPEDESC
    pdesc  As TPARAMDESC
End Type

Private Type TYPEATTR
    aGUID As GUID
    LCID As Long
    dwReserved As Long
    memidConstructor As Long
    memidDestructor As Long
    lpstrSchema As LongPtr
    cbSizeInstance As Integer
    typekind As Long
    cFuncs As Integer
    cVars As Integer
    cImplTypes As Integer
    cbSizeVft As Integer
    cbAlignment As Integer
    wTypeFlags As Integer
    wMajorVerNum As Integer
    wMinorVerNum As Integer
    tdescAlias As Long
    idldescType As Long
End Type

Private Type FUNCDESC
    memid As Long
    lReserved1 As LongPtr
    lprgelemdescParam As LongPtr
    funckind As Long
    INVOKEKIND As Long
    CallConv As Long
    cParams As Integer
    cParamsOpt As Integer
    oVft As Integer
    cReserved2 As Integer
    elemdescFunc As TELEMDESC
    wFuncFlags As Integer
End Type

Private Type MODULEINFO
    lpBaseOfDll As LongPtr
    SizeofImage As Long
    EntryPoint As LongPtr
End Type

Private Type INFO
    CI() As INTERFACE_INFO
    MI() As INTERFACE_INFO
    EI() As INTERFACE_INFO
    DI() As INTERFACE_INFO
End Type

Public Type ARRAYS
    arrClasses() As INTERFACE_INFO
    arrInterfaces() As INTERFACE_INFO
    arrDisps() As INTERFACE_INFO
    arrModules() As INTERFACE_INFO
    arrEnums() As INTERFACE_INFO
    arrTypes() As SEARCH_TARGET
    arrNames() As String
    arrFuncPtrs() As FUNC_INFO
    arrEnumPtrs() As ENUM_VALS
    arrPtrs() As LongPtr
    arrOtherInfo1() As TEXT_STRUCT
    arrOtherInfo2() As TEXT_STRUCT
    arrImplTypeFlags() As Long  'event flags
End Type

Public tArrays As ARRAYS


Function RetrieveLibInfo(ByVal sFile As String) As Boolean

    Dim lArrRows As Long, i As Long, j As Long
  
    Call EraseArrays
  
    With tArrays
        .arrClasses = TypeInfoFromCOMLib(sFile, CI).CI
        If (Not Not .arrClasses) = False Then
            Exit Function
        End If
      
        For i = LBound(.arrClasses) To UBound(.arrClasses)
            .arrInterfaces = InterFacesFromClass(.arrClasses(i))
            For j = LBound(.arrInterfaces) To UBound(.arrInterfaces)
                ReDim Preserve .arrNames(lArrRows)
                ReDim Preserve .arrPtrs(lArrRows)
                ReDim Preserve .arrTypes(lArrRows)
                ReDim Preserve .arrImplTypeFlags(lArrRows)
                ReDim Preserve .arrOtherInfo1(lArrRows)
                ReDim Preserve .arrOtherInfo2(lArrRows)
                .arrNames(lArrRows) = ChrW(&H25A0) & " " & .arrInterfaces(j).Name
                .arrPtrs(lArrRows) = .arrInterfaces(j).Ptr
                .arrTypes(lArrRows) = Class_
                .arrImplTypeFlags(lArrRows) = .arrInterfaces(j).IMPLTYPEFLAGS
                .arrOtherInfo1(lArrRows) = BuildClassInfoString(.arrInterfaces(j), False)
                .arrOtherInfo2(lArrRows) = BuildClassInfoString(.arrInterfaces(j), True)
                lArrRows = lArrRows + 1&
            Next j
        Next i
  
        .arrDisps = TypeInfoFromCOMLib(sFile, DI).DI
        If Not Not .arrDisps Then
            For i = LBound(.arrDisps) To UBound(.arrDisps)
                ReDim Preserve .arrNames(lArrRows)
                ReDim Preserve .arrPtrs(lArrRows)
                ReDim Preserve .arrTypes(lArrRows)
                ReDim Preserve .arrOtherInfo1(lArrRows)
                ReDim Preserve .arrOtherInfo2(lArrRows)
                .arrNames(lArrRows) = ChrW(&H25A0) & " " & .arrDisps(i).Name
                .arrPtrs(lArrRows) = .arrDisps(i).Ptr
                .arrTypes(lArrRows) = Interface_
                .arrOtherInfo1(lArrRows) = BuildClassInfoString(.arrDisps(i), False)
                .arrOtherInfo2(lArrRows) = BuildClassInfoString(.arrDisps(i), True)
                lArrRows = lArrRows + 1&
            Next
        End If
  
        .arrModules = TypeInfoFromCOMLib(sFile, MI).MI
        If Not Not .arrModules Then
            For i = LBound(.arrModules) To UBound(.arrModules)
                ReDim Preserve .arrNames(lArrRows)
                ReDim Preserve .arrPtrs(lArrRows)
                ReDim Preserve .arrTypes(lArrRows)
                ReDim Preserve .arrOtherInfo1(lArrRows)
                ReDim Preserve .arrOtherInfo2(lArrRows)
                .arrNames(lArrRows) = ChrW(&H25E5) & " " & .arrModules(i).Name
                .arrPtrs(lArrRows) = .arrModules(i).Ptr
                .arrTypes(lArrRows) = Module_
                .arrOtherInfo1(lArrRows) = BuildClassInfoString(.arrModules(i), False)
                .arrOtherInfo2(lArrRows) = BuildClassInfoString(.arrModules(i), True)
                lArrRows = lArrRows + 1&
            Next i
        End If
  
        .arrEnums = TypeInfoFromCOMLib(sFile, EI).EI
        If Not Not .arrEnums Then
            For i = LBound(.arrEnums) To UBound(.arrEnums)
                ReDim Preserve .arrNames(lArrRows)
                ReDim Preserve .arrPtrs(lArrRows)
                ReDim Preserve .arrTypes(lArrRows)
                ReDim Preserve .arrOtherInfo1(lArrRows)
                ReDim Preserve .arrOtherInfo2(lArrRows)
               .arrNames(lArrRows) = ChrW(&H25CD) & " " & .arrEnums(i).Name
               .arrPtrs(lArrRows) = .arrEnums(i).Ptr
               .arrTypes(lArrRows) = Enum_
                .arrOtherInfo1(lArrRows) = BuildClassInfoString(.arrEnums(i), False)
                .arrOtherInfo2(lArrRows) = BuildClassInfoString(.arrEnums(i), True)
                lArrRows = lArrRows + 1&
            Next i
        End If
    End With

    RetrieveLibInfo = True

End Function

Sub EraseArrays()
    With tArrays
        Erase .arrClasses():     Erase .arrInterfaces()
        Erase .arrDisps():       Erase .arrModules()
        Erase .arrEnums():       Erase .arrTypes()
        Erase .arrNames():       Erase .arrFuncPtrs()
        Erase .arrEnumPtrs():    Erase .arrPtrs()
        Erase .arrOtherInfo1():  Erase .arrOtherInfo2()
        Erase .arrImplTypeFlags()
    End With
End Sub


Function TypeInfoFromCOMLib(ByVal sLibFile As String, ByVal eRequestedInfo As TKIND) As INFO

    Const REGKIND_NONE = 2&, MEMBERID_NIL = -1&
    Const TKIND_COCLASS = 5&, TKIND_MODULE = 2&, TKIND_ENUM = 0&, TKIND_DISPATCH = 4&
    Const S_OK = 0&, CC_STDCALL = 4&
    Dim pTKind As LongPtr, ppTInfo As LongPtr, farPtr As LongPtr, psGUID As LongPtr
    Dim tClassInfo As INTERFACE_INFO, tModuleInfo As INTERFACE_INFO
    Dim tDispInfo As INTERFACE_INFO, tEnumInfo As INTERFACE_INFO
    Dim tInfoArray As INFO
    Dim tTYPEATTR As TYPEATTR
    Dim unkTypLib As stdole.IUnknown
    Dim i As Long, j As Long, lRet As Long, lInfoCount As Long
    Dim sName As String
  
    lRet = LoadTypeLibEx(StrPtr(sLibFile), REGKIND_NONE, unkTypLib)
    If lRet <> S_OK Then
        MsgBox "Unable to load the " & sLibFile & " library.": Exit Function
    End If
    lInfoCount = vtblCall(ObjPtr(unkTypLib), 3& * PTR_LEN, vbLong, CC_STDCALL) 'ITypeLib::GetTypeInfoCount
    For i = 0& To lInfoCount - 1&
        lRet = vtblCall(ObjPtr(unkTypLib), 5& * PTR_LEN, vbLong, CC_STDCALL, i, VarPtr(pTKind)) ' ITypeLib::GetTypeInfoType
        If lRet <> S_OK Then
            MsgBox "Unable to retrieve the type of a type description.": Exit Function
        End If
        If pTKind = eRequestedInfo Then
            Select Case eRequestedInfo
                Case Is = CI
                    ReDim Preserve tInfoArray.CI(j)
                Case Is = MI
                    ReDim Preserve tInfoArray.MI(j)
                Case Is = DI
                    ReDim Preserve tInfoArray.DI(j)
                Case Is = EI
                    ReDim Preserve tInfoArray.EI(j)
            End Select
            lRet = vtblCall(ObjPtr(unkTypLib), 4& * PTR_LEN, vbLong, CC_STDCALL, i, VarPtr(ppTInfo)) 'ITypeLib::GetTypeInfo
            If lRet <> S_OK Then
                MsgBox "Unable to retrieve the specified type description in the library.": Exit Function
            End If
            lRet = vtblCall(ppTInfo, 3& * PTR_LEN, vbLong, CC_STDCALL, VarPtr(farPtr)) 'ITypeInfo::GetTypeAttr
            If lRet <> S_OK Then
                MsgBox "Unable to retrieve a TYPEATTR structure that contains the attributes of the type description."
                Exit Function
            End If
            Call CopyMemory(tTYPEATTR, ByVal farPtr, LenB(tTYPEATTR))
            lRet = vtblCall(ppTInfo, 19& * PTR_LEN, vbEmpty, CC_STDCALL, farPtr) 'ITypeInfo::ReleaseTypeAttr
            Call StringFromIID(tTYPEATTR.aGUID, VarPtr(psGUID))
             lRet = vtblCall(ppTInfo, 12& * PTR_LEN, vbLong, CC_STDCALL, MEMBERID_NIL, VarPtr(sName), NULL_PTR, NULL_PTR, NULL_PTR)  'ITypeInfo::GetDocumentation
            If lRet <> S_OK Then
                MsgBox "Unable to retrieve the documentation string.": Exit Function
            End If
            Select Case pTKind
                Case Is = TKIND_COCLASS
                    With tClassInfo
                        .Ptr = ppTInfo
                        .GUID = GetStrFromPtrW(psGUID)
                        .LCID = tTYPEATTR.LCID
                        .memidConstructor = tTYPEATTR.memidConstructor
                        .memidDestructor = tTYPEATTR.memidDestructor
                        .Name = sName
                        .MembersCount = tTYPEATTR.cFuncs
                        .InterfacesCount = tTYPEATTR.cImplTypes
                        .wMajorVerNum = tTYPEATTR.wMajorVerNum
                        .wMinorVerNum = tTYPEATTR.wMinorVerNum
                    End With
                    tInfoArray.CI(j) = tClassInfo
                Case Is = TKIND_MODULE
                    With tModuleInfo
                        .Ptr = ppTInfo
                        .GUID = GetStrFromPtrW(psGUID)
                        .LCID = tTYPEATTR.LCID
                        .memidConstructor = tTYPEATTR.memidConstructor
                        .memidDestructor = tTYPEATTR.memidDestructor
                        .Name = sName
                        .MembersCount = tTYPEATTR.cFuncs
                        .InterfacesCount = tTYPEATTR.cImplTypes    '
                        .wMajorVerNum = tTYPEATTR.wMajorVerNum
                        .wMinorVerNum = tTYPEATTR.wMinorVerNum
                    End With
                    tInfoArray.MI(j) = tModuleInfo
                 Case Is = TKIND_DISPATCH
                    With tDispInfo
                        .Ptr = ppTInfo
                        .GUID = GetStrFromPtrW(psGUID)
                        .LCID = tTYPEATTR.LCID
                        .memidConstructor = tTYPEATTR.memidConstructor
                        .memidDestructor = tTYPEATTR.memidDestructor
                        .Name = sName
                        .MembersCount = tTYPEATTR.cFuncs
                        .InterfacesCount = tTYPEATTR.cImplTypes
                        .wMajorVerNum = tTYPEATTR.wMajorVerNum
                        .wMinorVerNum = tTYPEATTR.wMinorVerNum
                    End With
                    tInfoArray.DI(j) = tDispInfo
                Case Is = TKIND_ENUM
                    With tEnumInfo
                        .Ptr = ppTInfo
                        .GUID = GetStrFromPtrW(psGUID)
                        .LCID = tTYPEATTR.LCID
                        .memidConstructor = tTYPEATTR.memidConstructor
                        .memidDestructor = tTYPEATTR.memidDestructor
                        .Name = sName
                        .MembersCount = tTYPEATTR.cVars
                        .wMajorVerNum = tTYPEATTR.wMajorVerNum
                        .wMinorVerNum = tTYPEATTR.wMinorVerNum
                    End With
                    tInfoArray.EI(j) = tEnumInfo
            End Select
            j = j + 1&
        End If
    Next
    TypeInfoFromCOMLib = tInfoArray

End Function

Function GetFuncs( _
    ByVal ppTInfo As LongPtr, _
    ByVal ImpEvent As IMPLTYPEFLAGS, _
    Optional ByVal FuncCallType As VbCallType, _
    Optional ByVal unk As Boolean _
) As FUNC_INFO()
  
    Const CC_STDCALL = 4&, S_OK = 0&
    Dim aTYPEATTR() As LongPtr, aFUNCDESC() As LongPtr, farPtr As LongPtr
    Dim tTYPEATTR As TYPEATTR, tFuncDesc As FUNCDESC, tFuncDescArray() As FUNC_INFO
    Dim aGUID(0& To 11&) As Long
    Dim lRet As Long, lFuncsCount As Long, n As Long
    Dim sFuncName As String
    Dim IUnkIDisp As Variant
  
    lRet = vtblCall(ppTInfo, 3& * PTR_LEN, vbLong, CC_STDCALL, VarPtr(farPtr))  'ITypeInfo::GetTypeAttr
    If lRet <> S_OK Then
        MsgBox "Unable to retrieve a TYPEATTR structure that contains the attributes of the type description."
        Exit Function
    End If
    Call CopyMemory(ByVal VarPtr(tTYPEATTR), ByVal farPtr, LenB(tTYPEATTR))
    ReDim aTYPEATTR(LenB(tTYPEATTR))
    Call CopyMemory(ByVal VarPtr(aTYPEATTR(0&)), tTYPEATTR, UBound(aTYPEATTR))
    lRet = vtblCall(ppTInfo, 19& * PTR_LEN, vbEmpty, CC_STDCALL, farPtr)  'ITypeInfo::ReleaseTypeAttr
    If tTYPEATTR.cFuncs Then
        For lFuncsCount = 0& To tTYPEATTR.cVars + tTYPEATTR.cFuncs - 1&
            lRet = vtblCall(ppTInfo, 5& * PTR_LEN, vbLong, CC_STDCALL, lFuncsCount, VarPtr(farPtr)) 'ITypeInfo::GetFuncDesc
            If farPtr = NULL_PTR Then Exit Function
            If lRet <> S_OK Then
                MsgBox "Unable to retrieve the FUNCDESC structure that contains information about a specified function."
                Exit Function
            End If
            If farPtr = NULL_PTR Then GoTo SkipFunc
            Call CopyMemory(ByVal VarPtr(tFuncDesc), ByVal farPtr, LenB(tFuncDesc))
            ReDim aFUNCDESC(LenB(tFuncDesc))
            Call CopyMemory(ByVal VarPtr(aFUNCDESC(0)), tFuncDesc, UBound(aFUNCDESC))
            lRet = vtblCall(ppTInfo, 20& * PTR_LEN, vbEmpty, CC_STDCALL, farPtr) 'ITypeInfo::ReleaseFuncDesc
            lRet = vtblCall(ppTInfo, 12& * PTR_LEN, vbLong, CC_STDCALL, aFUNCDESC(0), VarPtr(sFuncName), NULL_PTR, NULL_PTR, NULL_PTR)  'ITypeInfo::GetDocumentation
            If lRet <> S_OK Then
                MsgBox "Unable to retrieve the documentation string.": Exit Function
            End If
            IUnkIDisp = Array("QueryInterface", "AddRef", "Release", "GetTypeInfoCount", "GetTypeInfo", "GetIDsOfNames", "Invoke")
            If IsError(Application.Match(sFuncName, IUnkIDisp, 0&)) = False And unk = False Then GoTo SkipFunc
            With tFuncDesc
                If (.INVOKEKIND And FuncCallType) = .INVOKEKIND Then
                    ReDim Preserve tFuncDescArray(n)
                    tFuncDescArray(n).Name = sFuncName
                    tFuncDescArray(n).memid = .memid
                    tFuncDescArray(n).CallConvention = .CallConv
                    tFuncDescArray(n).funckind = .funckind
                    tFuncDescArray(n).VTBLOffset = .oVft
                    If ImpEvent And (IMPLTYPEFLAG_FDEFAULT Or IMPLTYPEFLAG_FSOURCE) = ImpEvent Then
                        If IsError(Application.Match(sFuncName, IUnkIDisp, 0&)) Then
                            tFuncDescArray(n).INVOKEKIND = "VbMethod  [Event]"
                        Else
                            tFuncDescArray(n).INVOKEKIND = Switch(.INVOKEKIND = 1&, "VbMethod", .INVOKEKIND = 2&, "VbGet", .INVOKEKIND = 4&, "VbLet", .INVOKEKIND = 8&, "VbSet")
                        End If
                    Else
                        tFuncDescArray(n).INVOKEKIND = Switch(.INVOKEKIND = 1&, "VbMethod", .INVOKEKIND = 2&, "VbGet", .INVOKEKIND = 4&, "VbLet", .INVOKEKIND = 8&, "VbSet")
                    End If
                    tFuncDescArray(n).ParamsCount = .cParams
                    tFuncDescArray(n).OptParamsCount = .cParamsOpt
                    tFuncDescArray(n).ReturnType = ReturnType(.elemdescFunc.tdesc.vt)
                    n = n + 1&
                End If
            End With
SkipFunc:
            If lFuncsCount Mod 100& = 0& Then DoEvents
        Next
        GetFuncs = tFuncDescArray
    End If

End Function

Function GetClassAttributes(ByVal sLibFile As String, ByVal pFindTypeInfo As LongPtr) As INTERFACE_INFO

    Const REGKIND_NONE = 2&, MEMBERID_NIL = -1&, TKIND_ENUM = 0&
    Const S_OK = 0&, CC_STDCALL = 4&
    Dim pTKind As LongPtr, ppTInfo As LongPtr, farPtr As LongPtr, psGUID As LongPtr
    Dim tClassInfo As INTERFACE_INFO, tTYPEATTR As TYPEATTR
    Dim unkTypLib As stdole.IUnknown
    Dim i As Long, lRet As Long, lInfoCount As Long
    Dim sTypeInfoName As String
  
    lRet = LoadTypeLibEx(StrPtr(sLibFile), REGKIND_NONE, unkTypLib)
    If lRet <> S_OK Then
        MsgBox "Unable to load the " & sLibFile & " library.": Exit Function
    End If
    lInfoCount = vtblCall(ObjPtr(unkTypLib), 3& * PTR_LEN, vbLong, CC_STDCALL) 'ITypeLib::GetTypeInfoCount
    For i = 0& To lInfoCount - 1&
        lRet = vtblCall(ObjPtr(unkTypLib), 5& * PTR_LEN, vbLong, CC_STDCALL, i, VarPtr(pTKind)) ' ITypeLib::GetTypeInfoType
        If lRet <> S_OK Then
            MsgBox "Unable to retrieve the type of a type description.": Exit Function
        End If
        lRet = vtblCall(ObjPtr(unkTypLib), 4& * PTR_LEN, vbLong, CC_STDCALL, i, VarPtr(ppTInfo)) 'ITypeLib::GetTypeInfo
        If lRet <> S_OK Then
            MsgBox "Unable to retrieve the specified type description in the library.": Exit Function
        End If
        lRet = vtblCall(ppTInfo, 3& * PTR_LEN, vbLong, CC_STDCALL, VarPtr(farPtr)) 'ITypeInfo::GetTypeAttr
        If lRet <> S_OK Then
            MsgBox "Unable to retrieve a TYPEATTR structure that contains the attributes of the type description."
            Exit Function
        End If
        Call CopyMemory(tTYPEATTR, ByVal farPtr, LenB(tTYPEATTR))
        lRet = vtblCall(ppTInfo, 19& * PTR_LEN, vbEmpty, CC_STDCALL, farPtr) 'ITypeInfo::ReleaseTypeAttr
        Call StringFromIID(tTYPEATTR.aGUID, VarPtr(psGUID))
        lRet = vtblCall(ppTInfo, 12& * PTR_LEN, vbLong, CC_STDCALL, MEMBERID_NIL, VarPtr(sTypeInfoName), NULL_PTR, NULL_PTR, NULL_PTR)  'ITypeInfo::GetDocumentation
        If lRet <> S_OK Then
            MsgBox "Unable to retrieve the documentation string.": Exit Function
        End If
        If pFindTypeInfo = ppTInfo And pTKind <> TKIND_ENUM Then
            With tClassInfo
                .Ptr = pFindTypeInfo
                .GUID = GetStrFromPtrW(psGUID)
                .LCID = tTYPEATTR.LCID
                .memidConstructor = tTYPEATTR.memidConstructor
                .memidDestructor = tTYPEATTR.memidDestructor
                .Name = sTypeInfoName
                .MembersCount = tTYPEATTR.cFuncs
                .InterfacesCount = tTYPEATTR.cImplTypes
                .wMajorVerNum = tTYPEATTR.wMajorVerNum
                .wMinorVerNum = tTYPEATTR.wMinorVerNum
            End With
            Exit For
        End If
    Next
    GetClassAttributes = tClassInfo

End Function

Function MembersFromEnum(pEnum As LongPtr) As ENUM_VALS()

    Const S_OK = 0&, CC_STDCALL = 4&
    Dim ppTypeAttr As LongPtr, pcNames As LongPtr
    Dim tTYPEATTR As TYPEATTR, tVARDESC As VARDESC
    Dim tDUMMYUNIONNAME As DUMMYUNIONNAME_TYPE, tLRG_INT As LARGE_INT
    Dim pVARDESC  As LongPtr, BstrName As String
    Dim vRet() As ENUM_VALS
    Dim i As Long, lRet As Long
  
    lRet = vtblCall(pEnum, 3& * PTR_LEN, vbLong, CC_STDCALL, VarPtr(ppTypeAttr)) 'ITypeInfo::GetTypeAttr
    If lRet <> S_OK Then
        MsgBox "Unable to retrieve a TYPEATTR structure that contains the attributes of the type description."
        Exit Function
    End If
    If ppTypeAttr = NULL_PTR Then Exit Function
    Call CopyMemory(ByVal VarPtr(tTYPEATTR), ByVal ppTypeAttr, LenB(tTYPEATTR))
    lRet = vtblCall(pEnum, 19& * PTR_LEN, vbEmpty, CC_STDCALL, ppTypeAttr) 'ITypeInfo::ReleaseTypeAttr
    ReDim vRet(tTYPEATTR.cVars - 1&)
    For i = 0& To tTYPEATTR.cVars - 1&
        lRet = vtblCall(pEnum, 6& * PTR_LEN, vbLong, CC_STDCALL, i, VarPtr(pVARDESC)) 'ITypeInfo::GetVarDesc
        If lRet <> S_OK Then
            MsgBox "Unable to retrieves a VARDESC structure that describes the specified variable."
            Exit Function
        End If
        Call CopyMemory(ByVal VarPtr(tVARDESC), ByVal pVARDESC, LenB(tVARDESC))
        lRet = vtblCall(pEnum, 7& * PTR_LEN, vbLong, CC_STDCALL, tVARDESC.memid, VarPtr(BstrName), tTYPEATTR.cVars, VarPtr(pcNames))  'ITypeInfo::GetNames
        If lRet <> S_OK Then
            MsgBox "Unable to retrieves the variable with the specified member ID or the name of the property or method."
            Exit Function
        End If
        Call CopyMemory(tDUMMYUNIONNAME, ByVal tVARDESC.DUMMYUNIONNAME, Len(tDUMMYUNIONNAME))
        Call CopyMemory(ByVal tLRG_INT, tDUMMYUNIONNAME.lpvarValue, PTR_LEN)
        vRet(i).Name = BstrName
        vRet(i).Value = tLRG_INT.LowPart
        MembersFromEnum = vRet
    Next i

End Function

Function BuildFuncInfoString(INFO As FUNC_INFO) As TEXT_STRUCT
    Dim tString As TEXT_STRUCT
    With tString
        .Caption = _
            "[Member Name:]" & vbLf & _
            "[INVOKEKIND:]" & vbLf & _
            "[memid:]" & vbLf & _
            "[ParamsCount:]" & vbLf & _
            "[Opt ParamsCount:]" & vbLf & _
            "[Funckind:]" & vbLf & _
            "[VTBLOffset:]" & vbLf & _
            "[CallConvention:]" & vbLf & _
            "[ReturnType:]"
        .Value = _
            INFO.Name & vbLf & _
            INFO.INVOKEKIND & vbLf & _
            INFO.memid & vbLf & _
            INFO.ParamsCount & vbLf & _
            INFO.OptParamsCount & vbLf & _
            INFO.funckind & vbLf & _
            Hex(INFO.VTBLOffset) & vbLf & _
            INFO.CallConvention & vbLf & _
            INFO.ReturnType
    End With
    BuildFuncInfoString = tString
End Function

Function BuildEnumInfoString(INFO As ENUM_VALS) As TEXT_STRUCT
    Dim tString As TEXT_STRUCT
    With tString
        .Caption = _
            "[Const Name:]" & vbLf & _
            "[Value:]"
        .Value = _
            INFO.Name & vbLf & _
            INFO.Value
     End With
    BuildEnumInfoString = tString
End Function

Function GUIDFromLib(ByVal LibPathName As String) As String
    Const REGKIND_NONE = 2&, S_OK = 0&, CC_STDCALL = 4&
    Dim ppTLibAttr As LongPtr, psGUID As LongPtr
    Dim unkTypLib As stdole.IUnknown, tTYPEATTR As TYPEATTR
    Dim lRet As Long, sGUID As String

    lRet = LoadTypeLibEx(StrPtr(LibPathName), REGKIND_NONE, unkTypLib)
    lRet = vtblCall(ObjPtr(unkTypLib), 7& * PTR_LEN, vbLong, CC_STDCALL, VarPtr(ppTLibAttr))  'ITypeLib:: GetLibAttr
    If lRet = S_OK And ppTLibAttr Then
        Call CopyMemory(tTYPEATTR, ByVal ppTLibAttr, LenB(tTYPEATTR))
        Call StringFromIID(tTYPEATTR.aGUID, VarPtr(psGUID))
        sGUID = GetStrFromPtrW(psGUID)
        If Len(Trim(sGUID)) Then
            GUIDFromLib = sGUID
        End If
    lRet = vtblCall(ObjPtr(unkTypLib), 12& * PTR_LEN, vbLong, CC_STDCALL, ppTLibAttr)  'ITypeLib:: ReleaseTLibAttr
    End If
End Function

Function GUIDFromRefLib(ByVal LibPathName As String) As String
    '[ Requires References :: Visual Basic for Applications Extensibility And Trust access to Visual Basic Project ]
    Dim oRef As VBIDE.Reference, oRefs As VBIDE.References
    Set oRefs = Application.VBE.ActiveVBProject.References
    On Error Resume Next
    For Each oRef In oRefs
        If oRef.FullPath = LibPathName Then
            GUIDFromRefLib = oRef.GUID: Exit For
        End If
    Next oRef
End Function

Function RefLibNameToFullPath(ByVal ReferenceLibName As String) As String
    '[ Requires References :: Visual Basic for Applications Extensibility And Trust access to Visual Basic Project ]
    Dim oRef As VBIDE.Reference, oRefs As VBIDE.References, i As Integer
    On Error Resume Next
    Set oRefs = Application.VBE.ActiveVBProject.References
        For Each oRef In oRefs
        i = i + 1&
        If LCase(oRef.Name) = LCase(ReferenceLibName) Then
            RefLibNameToFullPath = oRef.FullPath:   Exit For
        End If
    Next oRef
End Function

Function GetVBEReferencesList() As String()
    '[ Requires References :: Visual Basic for Applications Extensibility And Trust access to Visual Basic Project ]
    Dim oRef As VBIDE.Reference, oRefs As VBIDE.References, i As Integer, tmpArray() As String
    Set oRefs = Application.VBE.ActiveVBProject.References
    For Each oRef In oRefs
        ReDim Preserve tmpArray(i)
        tmpArray(i) = oRef.Name: i = i + 1&
    Next oRef
    GetVBEReferencesList = tmpArray
End Function

Function GetSpecialEnum(sEnum As String) As Boolean
    'Handle special vba constants not defined in the enumerations module.
    Dim a() As Variant, v As Variant
    a = Array("Constants", "KeyCodeConstants", "ColorConstants", "SystemColorConstants")
    For Each v In a
        If ChrW(&H25E5) & " " & v = sEnum Then
            GetSpecialEnum = True: Exit Function
        End If
    Next v
End Function

Function BuildSpecailEnumValues(ByVal sEnum As String, Optional sPfx As String) As SPECIAL_ENUMS

    Dim x() As String, y() As String

    Select Case sEnum
        Case ChrW(&H25E5) & " " & "Constants"
            ReDim x(10):                                ReDim y(10)
            x(0) = sPfx & "vbObjectError":              y(0) = -2147221504
            x(1) = sPfx & "vbNullString":               y(1) = vbNullString
            x(2) = sPfx & "vbNullChar":                 y(2) = vbNullChar
            x(3) = sPfx & "vbCrLf":                     y(3) = vbCrLf
            x(4) = sPfx & "vbNewLine":                  y(4) = vbNewLine
            x(5) = sPfx & "vbCr":                       y(5) = vbCr
            x(6) = sPfx & "vbLf":                       y(6) = vbLf
            x(7) = sPfx & "vbBack":                     y(7) = vbBack
            x(8) = sPfx & "vbFormFeed":                 y(8) = vbFormFeed
            x(9) = sPfx & "vbTab":                      y(9) = vbTab
            x(10) = sPfx & "vbVerticalTab":             y(10) = vbVerticalTab
  
        Case ChrW(&H25E5) & " " & "KeyCodeConstants"
            ReDim x(98):                                ReDim y(98)
            x(0) = sPfx & "vbKeyLButton":               y(0) = 1
            x(1) = sPfx & "vbKeyRButton":               y(1) = 2
            x(2) = sPfx & "vbKeyCancel":                y(2) = 3
            x(3) = sPfx & "vbKeyMButton":               y(3) = 4
            x(4) = sPfx & "vbKeyBack":                  y(4) = 8
            x(5) = sPfx & "vbKeyTab":                   y(5) = 9
            x(6) = sPfx & "vbKeyClear":                 y(6) = 12
            x(7) = sPfx & "vbKeyReturn":                y(7) = 13
            x(8) = sPfx & "vbKeyShift":                 y(8) = 16
            x(9) = sPfx & "vbKeyControl":               y(9) = 17
            x(10) = sPfx & "vbKeyMenu":                 y(10) = 18
            x(11) = sPfx & "vbKeyPause":                y(11) = 19
            x(12) = sPfx & "vbKeyCapital":              y(12) = 20
            x(13) = sPfx & "vbKeyEscape":               y(13) = 27
            x(14) = sPfx & "vbKeySpace":                y(14) = 32
            x(15) = sPfx & "vbKeyPageUp":               y(15) = 33
            x(16) = sPfx & "vbKeyPageDown":             y(16) = 34
            x(17) = sPfx & "vbKeyEnd":                  y(17) = 35
            x(18) = sPfx & "vbKeyHome":                 y(18) = 36
            x(19) = sPfx & "vbKeyLeft":                 y(19) = 37
            x(20) = sPfx & "vbKeyUp":                   y(20) = 38
            x(21) = sPfx & "vbKeyRight":                y(21) = 39
            x(22) = sPfx & "vbKeyDown":                 y(22) = 40
            x(23) = sPfx & "vbKeySelect":               y(23) = 41
            x(24) = sPfx & "vbKeyPrint":                y(24) = 42
            x(25) = sPfx & "vbKeyExecute":              y(25) = 43
            x(26) = sPfx & "vbKeySnapshot":             y(26) = 44
            x(27) = sPfx & "vbKeyInsert":               y(27) = 45
            x(28) = sPfx & "vbKeyDelete":               y(28) = 46
            x(29) = sPfx & "vbKeyHelp":                 y(29) = 47
            x(30) = sPfx & "vbKeyNumlock":              y(30) = 144
            x(31) = sPfx & "vbKeyA":                    y(31) = 65
            x(32) = sPfx & "vbKeyB":                    y(32) = 66
            x(33) = sPfx & "vbKeyC":                    y(33) = 67
            x(34) = sPfx & "vbKeyD":                    y(34) = 68
            x(35) = sPfx & "vbKeyE":                    y(35) = 69
            x(36) = sPfx & "vbKeyF":                    y(36) = 70
            x(37) = sPfx & "vbKeyG":                    y(37) = 71
            x(38) = sPfx & "vbKeyH":                    y(38) = 72
            x(39) = sPfx & "vbKeyI":                    y(39) = 73
            x(40) = sPfx & "vbKeyJ":                    y(40) = 74
            x(41) = sPfx & "vbKeyK":                    y(41) = 75
            x(42) = sPfx & "vbKeyL":                    y(42) = 76
            x(43) = sPfx & "vbKeyM":                    y(43) = 77
            x(44) = sPfx & "vbKeyN":                    y(44) = 78
            x(45) = sPfx & "vbKeyO":                    y(45) = 79
            x(46) = sPfx & "vbKeyP":                    y(46) = 80
            x(47) = sPfx & "vbKeyQ":                    y(47) = 81
            x(48) = sPfx & "vbKeyR":                    y(48) = 82
            x(49) = sPfx & "vbKeyS":                    y(49) = 83
            x(50) = sPfx & "vbKeyT":                    y(50) = 84
            x(51) = sPfx & "vbKeyU":                    y(51) = 85
            x(52) = sPfx & "vbKeyV":                    y(52) = 86
            x(53) = sPfx & "vbKeyW":                    y(53) = 87
            x(54) = sPfx & "vbKeyX":                    y(54) = 88
            x(55) = sPfx & "vbKeyY":                    y(55) = 89
            x(56) = sPfx & "vbKeyZ":                    y(56) = 90
            x(57) = sPfx & "vbKey0":                    y(57) = 48
            x(58) = sPfx & "vbKey1":                    y(58) = 49
            x(59) = sPfx & "vbKey2":                    y(59) = 50
            x(60) = sPfx & "vbKey3":                    y(60) = 51
            x(61) = sPfx & "vbKey4":                    y(61) = 52
            x(62) = sPfx & "vbKey5":                    y(62) = 53
            x(63) = sPfx & "vbKey6":                    y(63) = 54
            x(64) = sPfx & "vbKey7":                    y(64) = 55
            x(65) = sPfx & "vbKey8":                    y(65) = 56
            x(66) = sPfx & "vbKey9":                    y(66) = 57
            x(67) = sPfx & "vbKeyNumpad0":              y(67) = 96
            x(68) = sPfx & "vbKeyNumpad1":              y(68) = 97
            x(69) = sPfx & "vbKeyNumpad2":              y(69) = 98
            x(70) = sPfx & "vbKeyNumpad3":              y(70) = 99
            x(71) = sPfx & "vbKeyNumpad4":              y(71) = 100
            x(72) = sPfx & "vbKeyNumpad5":              y(72) = 101
            x(73) = sPfx & "vbKeyNumpad6":              y(73) = 102
            x(74) = sPfx & "vbKeyNumpad7":              y(74) = 103
            x(75) = sPfx & "vbKeyNumpad8":              y(75) = 104
            x(76) = sPfx & "vbKeyNumpad9":              y(76) = 105
            x(77) = sPfx & "vbKeyMultiply":             y(77) = 106
            x(78) = sPfx & "vbKeyAdd":                  y(78) = 107
            x(79) = sPfx & "vbKeySeparator":            y(79) = 108
            x(80) = sPfx & "vbKeySubtract":             y(80) = 109
            x(81) = sPfx & "vbKeyDecimal":              y(81) = 110
            x(82) = sPfx & "vbKeyDivide":               y(82) = 111
            x(83) = sPfx & "vbKeyF1":                   y(83) = 112
            x(84) = sPfx & "vbKeyF2":                   y(84) = 113
            x(85) = sPfx & "vbKeyF3":                   y(85) = 114
            x(86) = sPfx & "vbKeyF4":                   y(86) = 115
            x(87) = sPfx & "vbKeyF5":                   y(87) = 116
            x(88) = sPfx & "vbKeyF6":                   y(88) = 117
            x(89) = sPfx & "vbKeyF7":                   y(89) = 118
            x(90) = sPfx & "vbKeyF8":                   y(90) = 119
            x(91) = sPfx & "vbKeyF9":                   y(91) = 120
            x(92) = sPfx & "vbKeyF10":                  y(92) = 121
            x(93) = sPfx & "vbKeyF11":                  y(93) = 122
            x(94) = sPfx & "vbKeyF12":                  y(94) = 123
            x(95) = sPfx & "vbKeyF13":                  y(95) = 124
            x(96) = sPfx & "vbKeyF14":                  y(96) = 125
            x(97) = sPfx & "vbKeyF15":                  y(97) = 126
            x(98) = sPfx & "vbKeyF16":                  y(98) = 127
          
        Case ChrW(&H25E5) & " " & "ColorConstants"
            ReDim x(7):                                 ReDim y(7)
            x(0) = sPfx & "vbBlack":                    y(0) = 0
            x(1) = sPfx & "vbRed":                      y(1) = 255
            x(2) = sPfx & "vbGreen":                    y(2) = 65280
            x(3) = sPfx & "vbYellow":                   y(3) = 65535
            x(4) = sPfx & "vbBlue":                     y(4) = 16711680
            x(5) = sPfx & "vbMagenta":                  y(5) = 16711935
            x(6) = sPfx & "vbCyan":                     y(6) = 16776960
            x(7) = sPfx & "vbWhite":                    y(7) = 16777215

        Case ChrW(&H25E5) & " " & "SystemColorConstants"
            ReDim x(28):                                ReDim y(28)
            x(0) = sPfx & "vbScrollBars":               y(0) = -2147483648#
            x(1) = sPfx & "vbDesktop":                  y(1) = -2147483647
            x(2) = sPfx & "vbActiveTitleBar":           y(2) = -2147483646
            x(3) = "vbInactiveTitleBar":                y(3) = -2147483645
            x(4) = sPfx & "vbMenuBar":                  y(4) = -2147483644
            x(5) = sPfx & "vbWindowBackground":         y(5) = -2147483643
            x(6) = sPfx & "vbWindowFrame":              y(6) = -2147483642
            x(7) = sPfx & "vbMenuText":                 y(7) = -2147483641
            x(8) = sPfx & "vbWindowText":               y(8) = -2147483640
            x(9) = sPfx & "vbTitleBarText":             y(9) = -2147483639
            x(10) = sPfx & "vbActiveBorder":            y(10) = -2147483638
            x(11) = sPfx & "vbInactiveBorder":          y(11) = -2147483637
            x(12) = sPfx & "vbApplicationWorkspace":    y(12) = -2147483636
            x(13) = sPfx & "vbHighlight":               y(13) = -2147483635
            x(14) = sPfx & "vbHighlightText":           y(14) = -2147483634
            x(15) = sPfx & "vbButtonFace":              y(15) = -2147483633
            x(16) = sPfx & "vbButtonShadow":            y(16) = -2147483632
            x(17) = sPfx & "vbGrayText":                y(17) = -2147483631
            x(18) = sPfx & "vbButtonText":              y(18) = -2147483630
            x(19) = sPfx & "vbInactiveCaptionText":     y(19) = -2147483629
            x(20) = sPfx & "vb3DHighlight":             y(20) = -2147483628
            x(21) = sPfx & "vb3DFace":                  y(21) = -2147483633
            x(22) = sPfx & "vbMsgBox":                  y(22) = -2147483625
            x(23) = sPfx & "vbMsgBoxText":              y(23) = -2147483624
            x(24) = sPfx & "vb3DShadow":                y(24) = -2147483632
            x(25) = sPfx & "vb3DDKShadow":              y(25) = -2147483627
            x(26) = sPfx & "vb3DLight":                 y(26) = -2147483626
            x(27) = sPfx & "vbInfoText":                y(27) = -2147483625
            x(28) = sPfx & "vbInfoBackground":          y(28) = -2147483624
    End Select

    BuildSpecailEnumValues.Caption = x:                 BuildSpecailEnumValues.Value = y
End Function

Function GetModulesBaseNamesFromCurrentProcess() As String()

    Const MAX_PATH = 1024&, MAX_NUM_OF_MODULES = 1024&, HANDLE_SIZE = PTR_LEN, REGKIND_NONE = 2&
    Dim hModuleHandles(MAX_NUM_OF_MODULES) As LongPtr
    Dim hProc As LongPtr
    Dim sModName   As String
    Dim sModBaseName  As String
    Dim sModPath      As String
    Dim tModInfo     As MODULEINFO
    Dim lBytesNeeded As Long, lModCount As Long, i As Long, j As Long, lStrLen As Long
    Dim sModulesWithEmbeddedTlbsArray() As String
    Dim unkTypLib As stdole.IUnknown, lRet As Long

    hProc = GetCurrentProcess
    If EnumProcessModules(hProc, hModuleHandles(0&), (MAX_NUM_OF_MODULES * HANDLE_SIZE), lBytesNeeded) = False Then
        Debug.Print "EnumProcessModules failed"
        Exit Function
    End If
    lModCount = lBytesNeeded \ HANDLE_SIZE
    For i = 0& To lModCount - 1&
        If hModuleHandles(i) = 0& Then
            GoTo skipModule
        End If
        If GetModuleInformation(hProc, hModuleHandles(i), tModInfo, lBytesNeeded) = 0& Then
            GoTo skipModule
        End If
        sModName = Space(MAX_PATH + 1&)
        lStrLen = GetModuleFileNameExW(hProc, hModuleHandles(i), StrPtr(sModName), Len(sModName))
        sModPath = Mid(sModName, 1&, lStrLen)
        lRet = LoadTypeLibEx(StrPtr(sModPath), REGKIND_NONE, unkTypLib)
        If lRet Then GoTo skipModule
        ReDim Preserve sModulesWithEmbeddedTlbsArray(j)
        lStrLen = GetModuleBaseNameW(hProc, hModuleHandles(i), StrPtr(sModName), Len(sModName))
        sModBaseName = Mid(sModName, 1&, lStrLen)
        sModulesWithEmbeddedTlbsArray(j) = sModBaseName: j = j + 1&
skipModule:
    Next i
    GetModulesBaseNamesFromCurrentProcess = sModulesWithEmbeddedTlbsArray
    Erase hModuleHandles
    Call CloseHandle(hProc)

End Function
'

Function ModuleBaseNameToFullPath(ByVal BaseName As String) As String
    ModuleBaseNameToFullPath = ModuleFileName(BaseName)
End Function

Sub ExportTLibToSheet(ByVal sLib As String)

    Dim i As Long, j As Long, Rw As Long
    Dim sDecoration As String, sInvkind As String
    Dim ImpEvent As IMPLTYPEFLAGS, sPrevEnum As String
    Dim Funcs() As FUNC_INFO, Enums() As ENUM_VALS, lPtr As LongPtr
    Dim tSPECIAL_ENUMS As SPECIAL_ENUMS
    Dim oSh As Worksheet

    If RetrieveLibInfo(sLib) = False Then GoTo Xit
  
    Set oSh = Sheets.Add(, ActiveSheet)
    oSh.Name = "Exported " & Right(sLib, Len(sLib) - InStrRev(sLib, "\", -1)) & "_" & Sheets.Count
    oSh.[a2] = sLib
    Rw = 3&
  
    With tArrays
        For i = LBound(.arrNames) To UBound(.arrNames)
            lPtr = .arrPtrs(i)
            If .arrTypes(i) <> Enum_ Then
                Rw = Rw + 1&
                oSh.Cells(Rw, 2&) = .arrNames(i)
                If Not Not .arrImplTypeFlags Then
                    If i < UBound(.arrImplTypeFlags) Then
                        ImpEvent = .arrImplTypeFlags(i)
                    End If
                End If
              
                If GetSpecialEnum(.arrNames(i)) Then
                    tSPECIAL_ENUMS = BuildSpecailEnumValues(.arrNames(i), ChrW(&H2022) & " ")
                    If Not Not tSPECIAL_ENUMS.Caption Then
                        For j = LBound(tSPECIAL_ENUMS.Caption) To UBound(tSPECIAL_ENUMS.Caption)
                            Rw = Rw + 1&
                            oSh.Cells(Rw, 3&) = tSPECIAL_ENUMS.Caption(j)
                            oSh.Cells(Rw, 4&) = tSPECIAL_ENUMS.Value(j)
                        Next j
                    End If
                End If
              
                Funcs = GetFuncs( _
                    lPtr, _
                    ImpEvent, _
                    VbLet + _
                    VbGet + _
                    VbSet + _
                    VbMethod, _
                    True _
                )
              
                If Not Not Funcs Then
                    For j = LBound(Funcs) To UBound(Funcs)
                        Rw = Rw + 1&
                        sInvkind = Funcs(j).INVOKEKIND
                        Select Case sInvkind
                            Case Is = "VbGet", "VbLet", "VbSet"
                                sDecoration = ChrW(&H25A6) & " "
                            Case Is = "VbMethod"
                                sDecoration = ChrW(&H25B1) & " "
                            Case Is = "VbMethod  [Event]"
                                sDecoration = ChrW(&H2944) & " "
                        End Select
                        oSh.Cells(Rw, 3&) = sDecoration & Funcs(j).Name
                        oSh.Cells(Rw, 4&) = sInvkind
                    Next j
                End If
          
            Else
                Enums = MembersFromEnum(lPtr)
                If Not Not Enums Then
                    For j = LBound(Enums) To UBound(Enums)
                        If sPrevEnum <> .arrNames(i) Then
                            Rw = Rw + 1&
                            oSh.Cells(Rw, 2&) = .arrNames(i)
                        End If
                        Rw = Rw + 1&
                        sPrevEnum = .arrNames(i)
                        oSh.Cells(Rw, 3&) = Enums(j).Name
                        oSh.Cells(Rw, 4&) = Enums(j).Value
                    Next j
                End If
            End If
        Next i
    End With
    Call FormatExportSheet(oSh)
    Exit Sub
Xit:
    MsgBox "An error has occurred while exporting the tlb to the worksheet."

End Sub

' ______________________________________ PRIVATE SUBS _______________________________________________

Private Function InterFacesFromClass(tClass As INTERFACE_INFO) As INTERFACE_INFO()

    Const S_OK = 0&, CC_STDCALL = 4&, MEMBERID_NIL = -1&
    Dim pRefType As LongPtr, pClasstypeInfo As LongPtr, farPtr As LongPtr, psGUID As LongPtr
    Dim tTYPEATTR As TYPEATTR, tInterfaceInfo As INTERFACE_INFO
    Dim i As Long, lRet As Long, lInterfaceCount As Long
    Dim sInterfaceName As String, pImplTypeFlags As Long

    lInterfaceCount = tClass.InterfacesCount
    ReDim ar(lInterfaceCount - 1&) As INTERFACE_INFO
    With tClass
        For i = 0& To .InterfacesCount - 1&
            lRet = vtblCall(.Ptr, 8& * PTR_LEN, vbLong, CC_STDCALL, i, VarPtr(pRefType))  'ITypeInfo::GetRefTypeOfImplType
            If lRet <> S_OK Then
                MsgBox "Unable to retrieve the type description of the implemented interface type.": Exit Function
            End If
            lRet = vtblCall(.Ptr, 9& * PTR_LEN, vbLong, CC_STDCALL, i, VarPtr(pImplTypeFlags))  'ITypeInfo::GetImplTypeFlags
            lRet = vtblCall(.Ptr, 14& * PTR_LEN, vbLong, CC_STDCALL, pRefType, VarPtr(pClasstypeInfo))  'ITypeInfo::GetRefTypeInfo
            If lRet <> S_OK Then
                MsgBox "Unable to retrieve the referenced type descriptions.": Exit Function
            End If
            lRet = vtblCall(pClasstypeInfo, 12& * PTR_LEN, vbLong, CC_STDCALL, MEMBERID_NIL, VarPtr(sInterfaceName), NULL_PTR, NULL_PTR, NULL_PTR) 'ITypeInfo::GetDocumentation
            If lRet <> S_OK Then
                MsgBox "Unable to retrieve the documentation string.": Exit Function
            End If
            lRet = vtblCall(pClasstypeInfo, 3& * PTR_LEN, vbLong, CC_STDCALL, VarPtr(farPtr))  'ITypeInfo::GetTypeAttr
            If lRet <> S_OK Then
                MsgBox "Unable to retrieve a TYPEATTR structure that contains the attributes of the type description"
                Exit Function
            End If
            Call CopyMemory(tTYPEATTR, ByVal farPtr, LenB(tTYPEATTR))
            lRet = vtblCall(pClasstypeInfo, 19& * PTR_LEN, vbEmpty, CC_STDCALL, farPtr) 'ITypeInfo::ReleaseTypeAttr
            Call StringFromIID(tTYPEATTR.aGUID, VarPtr(psGUID))
            With tInterfaceInfo
                .Ptr = pClasstypeInfo
                .GUID = GetStrFromPtrW(psGUID)
                .Name = sInterfaceName
                .MembersCount = tTYPEATTR.cFuncs
                .wMajorVerNum = tTYPEATTR.wMajorVerNum
                .wMinorVerNum = tTYPEATTR.wMinorVerNum
                .IMPLTYPEFLAGS = pImplTypeFlags
            End With
            ar(i) = tInterfaceInfo
        Next i
    End With
    InterFacesFromClass = ar

End Function

Private Function vtblCall( _
    ByVal InterfacePointer As LongPtr, _
    ByVal VTableOffset As Long, _
    ByVal FunctionReturnType As Long, _
    ByVal CallConvention As Long, _
    ParamArray FunctionParameters() As Variant _
) As Variant
      
    Dim vParamPtr() As LongPtr

    If InterfacePointer = 0& Or VTableOffset < 0& Then Exit Function
    If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function

    Dim pIndex As Long, pCount As Long
    Dim vParamType() As Integer
    Dim vRtn As Variant, vParams() As Variant

    vParams() = FunctionParameters()
    pCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
    If pCount = 0& Then
        ReDim vParamPtr(0& To 0&)
        ReDim vParamType(0& To 0&)
    Else
        ReDim vParamPtr(0& To pCount - 1&)
        ReDim vParamType(0& To pCount - 1&)
        For pIndex = 0& To pCount - 1&
            vParamPtr(pIndex) = VarPtr(vParams(pIndex))
            vParamType(pIndex) = VarType(vParams(pIndex))
        Next
    End If

    pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, pCount, vParamType(0&), vParamPtr(0&), vRtn)
    If pIndex = 0& Then
        vtblCall = vRtn
    Else
        SetLastError pIndex
    End If

End Function

Private Function BuildClassInfoString(INFO As INTERFACE_INFO, bShowUnkDisp As Boolean) As TEXT_STRUCT
    Dim tString As TEXT_STRUCT
    With tString
        .Caption = _
            "[Class Name:] " & vbLf & _
            "[Members Count:] " & vbLf & _
            "[GUID:] " & vbLf & _
            "[LCID:] " & vbLf & _
            "[PTR:] "
        .Value = INFO.Name & vbLf & _
            IIf(bShowUnkDisp, INFO.MembersCount, INFO.MembersCount - 7&) & vbLf & _
            INFO.GUID & vbLf & _
            INFO.LCID & vbLf & _
            INFO.InterfacesCount
    End With
    BuildClassInfoString = tString
End Function

Private Function ReturnType(ByVal RetType As VarEnum) As String
    Dim sRetVarType As String
    Select Case RetType
        Case VT_NULL:                sRetVarType = "Long"
        Case VT_I2:                  sRetVarType = "Integer"
        Case VT_I4:                  sRetVarType = "Long"
        Case VT_R4:                  sRetVarType = "Single"
        Case VT_R8:                  sRetVarType = "Double"
        Case VT_CY:                  sRetVarType = "Currency"
        Case VT_DATE:                sRetVarType = "Date"
        Case VT_BSTR:                sRetVarType = "BSTR(String)"
        Case VT_DISPATCH, VT_PTR:    sRetVarType = "Object"
        Case VT_ERROR:               sRetVarType = "SCODE"
        Case VT_BOOL:                sRetVarType = "Boolean"
        Case VT_VARIANT:             sRetVarType = "VARIANT"
        Case VT_UNKNOWN:             sRetVarType = "IUnknown*"
        Case VT_UI1:                 sRetVarType = "Byte"
        Case VT_DECIMAL:             sRetVarType = "Decimal"
        Case VT_I1:                  sRetVarType = "Char"
        Case VT_UI2:                 sRetVarType = "USHORT"
        Case VT_UI4:                 sRetVarType = "ULONG"
        Case VT_I8:                  sRetVarType = "LongLong"
        Case VT_UI8:                 sRetVarType = "unsigned __int64"
        Case VT_INT:                 sRetVarType = "int"
        Case VT_UINT:                sRetVarType = "UINT"
        Case VT_HRESULT:             sRetVarType = "HRESULT"
        Case VT_VOID:                sRetVarType = "VOID"
        Case VT_LPSTR:               sRetVarType = "char*"
        Case VT_LPWSTR:              sRetVarType = "wchar_t*"
        Case Else:                   sRetVarType = "ANY"
    End Select
    ReturnType = sRetVarType
End Function

Private Function GetStrFromPtrW(ByVal lpString As LongPtr) As String
    Call SysReAllocString(VarPtr(GetStrFromPtrW), lpString)
    Call CoTaskMemFree(lpString)
End Function

Private Function ModuleFileName(ByVal ModuleName As String) As String
    Const MAX_PATH = 1024&
    Dim sBuffer As String, lRet As Long, hMod As LongPtr
    hMod = GetModuleHandleW(StrPtr(ModuleName))
        sBuffer = Space(MAX_PATH)
        lRet = GetModuleFileNameW(hMod, StrPtr(sBuffer), Len(sBuffer))
        ModuleFileName = Left(sBuffer, lRet)
End Function

Private Sub FormatExportSheet(ByVal Sh As Worksheet)
    Dim oRange As Range
    With Sh
        With .Range("A1:D1")
            .Cells(1) = "Type Library": .Cells(2) = "Class Name"
            .Cells(3) = "Member Name": .Cells(4) = "Member Type\Value"
            .Font.Bold = True
            .EntireColumn.AutoFit
            .Cells(1).Offset(1).Select
            ActiveWindow.FreezePanes = True
            ActiveWindow.Zoom = 90&
        End With
        Set oRange = .Range("B5:B" & .Range("B" & .UsedRange.Rows.Count).End(xlUp).Row)
        Set oRange = oRange.SpecialCells(xlCellTypeBlanks)
        Dim oArea  As Variant
        For Each oArea In oRange.Areas
            oArea.Rows.Group
        Next
        .Outline.ShowLevels RowLevels:=2
    End With
    MsgBox "Done exporting to worksheet."
End Sub


2- Browser UserForm Code:
VBA Code: 
Option Explicit

Private ElementType As SEARCH_TARGET
Private sCurLib As String

Private Sub UserForm_Initialize()
    Call SetUpControls
    ComboLibs.List = GetModulesBaseNamesFromCurrentProcess
    ComboLibs.ListIndex = 0&
    If RetrieveLibInfo(ModuleBaseNameToFullPath(ComboLibs.ListIndex)) Then
        ListClasses.List = tArrays.arrNames
    End If
    ComboRefs.List = GetVBEReferencesList
    ComboRefs.ListIndex = 0&
    If ListClasses.ListIndex = -1& And ListClasses.ListCount Then
        ListClasses.SetFocus
        ListClasses.ListIndex = 0&
    End If
End Sub

Private Sub UserForm_Terminate()
    Call EraseArrays
End Sub

Private Sub SetUpControls()
    txtCls.Text = ChrW(&H25A0)
    txtMod.Text = ChrW(&H25E5)
    txtEnum.Text = ChrW(&H25CD)
    txtProp.Text = ChrW(&H25A6)
    txtMethod.Text = ChrW(&H25B1)
    txtEvent.Text = ChrW(&H2944)
    txtConst.Text = ChrW(&H2022)
    TxtValues.MultiLine = True
    TxtCaptions.MultiLine = True
    ListClasses.Font.Size = 10&
    ListMembers.Font.Size = 10&
    ComboLibs.Font.Size = 10&
    ComboRefs.Font.Size = 10&
    chkLet.Value = True
    chkGet.Value = True
    chkSet.Value = True
    chkMethod.Value = True
End Sub

Private Sub ClearControls()
    ListClasses.Clear
    ListMembers.Clear
    TxtValues.Text = ""
    TxtCaptions.Text = ""
    Me.lblViweLib.Caption = ""
    Me.lblGUID.Caption = ""
End Sub

Private Sub ComboRefs_Change()
    Call ClearControls
    If RetrieveLibInfo(RefLibNameToFullPath(Me.ComboRefs.Value)) = False Then
       Call SetCountLabels(bClear:=True):   Exit Sub
    End If
    If Not Not tArrays.arrNames Then
        ListClasses.List = tArrays.arrNames
    End If
    sCurLib = RefLibNameToFullPath(ComboRefs.Value)
    lblViweLib.Caption = "- Viewing Library:   [" & sCurLib & "]"
    lblGUID.Caption = "- GUID:" & Space(18&) & "[" & GUIDFromRefLib(sCurLib) & "]"
    Call SetCountLabels
End Sub

Private Sub ComboLibs_Change()
    Dim sGUID As String
    Call ClearControls
    If RetrieveLibInfo(ModuleBaseNameToFullPath(ComboLibs.Value)) = False Then
        Call SetCountLabels(bClear:=True):   Exit Sub
    End If
    If Not Not tArrays.arrNames Then
        ListClasses.List = tArrays.arrNames
    End If
    sCurLib = ModuleBaseNameToFullPath(ComboLibs.Value)
    lblViweLib.Caption = "- Viewing Library:   [" & sCurLib & "]"
    sGUID = GUIDFromLib(ComboLibs.Value)
    If Len(sGUID) Then
        lblGUID.Caption = "- GUID:" & Space(18&) & "[" & sGUID & "]"
    End If
    Call SetCountLabels
End Sub

Private Sub ListMembers_Change()
    If ListMembers.ListIndex <> -1& Then
        If ElementType <> Enum_ And Not Not tArrays.arrFuncPtrs Then
            Me.TxtValues = BuildFuncInfoString(tArrays.arrFuncPtrs(ListMembers.ListIndex)).Value
            Me.TxtCaptions = BuildFuncInfoString(tArrays.arrFuncPtrs(ListMembers.ListIndex)).Caption
        Else
        If GetSpecialEnum(ListClasses.Value) Then
            TxtCaptions.Text = _
                "[Const Name:]" & vbLf & _
                "[Value:]"
            TxtValues.Text = ListMembers.Value & vbLf & _
            BuildSpecailEnumValues(ListClasses.Value).Value(ListMembers.ListIndex)
            Exit Sub
        End If
            TxtValues = BuildEnumInfoString(tArrays.arrEnumPtrs(ListMembers.ListIndex)).Value
            TxtCaptions = BuildEnumInfoString(tArrays.arrEnumPtrs(ListMembers.ListIndex)).Caption
        End If
    End If

End Sub

Private Sub ListClasses_Change()

    #If Win64 Then
        Dim lPtr As LongLong
    #Else
        Dim lPtr As Long
    #End If
    Dim Funcs() As FUNC_INFO, Enums() As ENUM_VALS
    Dim ImpEvent As Long
    Dim sDecoration As String, i As Long
  
    If ListClasses.ListIndex = -1& Then Exit Sub
    ListMembers.Clear

    'Handle special vba module-based enums (Constants-KeyCodeConstants-ColorConstants-SystemColorConstants)
    If GetSpecialEnum(ListClasses.Value) Then
        ElementType = Enum_
        ListMembers.List = BuildSpecailEnumValues(ListClasses.Value, ChrW(&H2022) & " ").Caption
    End If
  
    With tArrays
        Erase .arrFuncPtrs:     Erase .arrEnumPtrs
      
        ElementType = .arrTypes(ListClasses.ListIndex)
      
        'Store ImplTypeFlags for event interfaces use.
        If ListClasses.ListIndex <= UBound(.arrImplTypeFlags) Then
            ImpEvent = .arrImplTypeFlags(ListClasses.ListIndex)
        End If
        lPtr = .arrPtrs(ListClasses.ListIndex)
      
        'retrieve all members\funcs.
        Funcs = GetFuncs( _
            lPtr, _
            ImpEvent, _
            Abs(CLng(chkLet.Value)) * VbLet + _
            Abs(CLng(chkGet.Value)) * VbGet + _
            Abs(CLng(chkSet.Value)) * VbSet + _
            Abs(CLng(chkMethod.Value)) * VbMethod, _
            chkIUnkDisp.Value _
        )
      
        'add class members to listbox.
        If Not Not Funcs Then
            For i = LBound(Funcs) To UBound(Funcs)
                ReDim Preserve .arrFuncPtrs(i)
                .arrFuncPtrs(i) = Funcs(i)
                Select Case Funcs(i).INVOKEKIND
                    Case Is = "VbGet", "VbLet", "VbSet"
                        sDecoration = ChrW(&H25A6) & " "
                    Case Is = "VbMethod"
                        sDecoration = ChrW(&H25B1) & " "
                    Case Is = "VbMethod  [Event]"
                        sDecoration = ChrW(&H2944) & " "
                End Select
                ListMembers.AddItem sDecoration & Funcs(i).Name
            Next i
        End If
  
        'add enums to listbox.
        If Not Funcs Then
                If .arrTypes(ListClasses.ListIndex) = Enum_ Then
                    Enums = MembersFromEnum(lPtr)
                    If Not Not Enums Then
                        For i = LBound(Enums) To UBound(Enums)
                            ReDim Preserve .arrEnumPtrs(i)
                            .arrEnumPtrs(i) = Enums(i)
                            ListMembers.AddItem ChrW(&H2022) & " " & Enums(i).Name
                        Next i
                    End If
                End If
        End If
  
        'show info about the selected item.
        TxtCaptions.Text = .arrOtherInfo1(ListClasses.ListIndex).Caption
        If chkIUnkDisp.Value Or .arrTypes(ListClasses.ListIndex) = Enum_ Then
            TxtValues.Text = .arrOtherInfo2(ListClasses.ListIndex).Value
        End If
      
    End With
  
    If tArrays.arrTypes(ListClasses.ListIndex) <> Enum_ Then
    Me.TxtValues = BuildClassInfoStringXXXX(GetClassAttributes(sCurLib, lPtr), Me.chkIUnkDisp.Value)
    End If
  

    lblMembersCount = "   [" & ListMembers.ListCount & "]"

End Sub

Private Sub btnExportToSheet_Click()
    If Len(Dir(sCurLib)) Then
        Application.ScreenUpdating = False
        Call ExportTLibToSheet(sCurLib)
        Application.ScreenUpdating = True
    End If
End Sub

Private Sub SetCountLabels(Optional bClear As Boolean)
    If bClear Then
        lblClassesCount = ""
    Else
        lblClassesCount = "   [" & ListClasses.ListCount & "]"
    End If
    lblMembersCount = ""
End Sub

Function BuildClassInfoStringXXXX(INFO As INTERFACE_INFO, bShowUnkDisp As Boolean) As String
        If ElementType <> Enum_ Then
        BuildClassInfoStringXXXX = INFO.Name & vbLf & _
            IIf(bShowUnkDisp, INFO.MembersCount, ListMembers.ListCount) & vbLf & _
            INFO.GUID & vbLf & _
            INFO.LCID & vbLf & _
            INFO.Ptr
        End If
End Function
 
Upvote 1
Hello again Jaafar,

I am speechless, you are a very experienced and passionate Excel VBA professional. I have tried the solution you created and it works, thank you very, very much !

I have checked, it seems that hidden classes, and their members are not extracted and generated to Excel list. One example is Balloon class.

I would like to ask you if you can consider in the Member Type\Value column (the last column of the list generated by the macro) following possible values Function, Constant, Sub, Property, Enum, or Event, etc. (as we can see in the Excel Object Browser). Is this possible ?

My best regards,
Romulus Milea.
 
Upvote 0
@RomulusMilea

I have checked, it seems that hidden classes, and their members are not extracted and generated to Excel list. One example is Balloon class.
Click to expand...
You mean the balloon class in the Office Librarry (MSO.dll) ? It is actually extracted as shown in the screen shot below:

Untjkdfksjfitled.png




I would like to ask you if you can consider in the Member Type\Value column (the last column of the list generated by the macro) following possible values Function, Constant, Sub, Property, Enum, or Event, etc. (as we can see in the Excel Object Browser). Is this possible ?
Click to expand...
Sorry. I am not sure I understand what ypu mean exactly. Can you rephrase the question.


PS: VbGet, VbLet and VbSet are Properties, VbMethod are SUBs or Functios, Enums are constants etc ... They are actually all there already in the Member Type\Value column under those specific names.
 
Last edited:
Upvote 0
UPDATE
VBA_Custom_ObjBrowser.xlsm

When used in excel x32bit, the code returned wrong Enum values. this bug went unnoticed until I tested the code this morning in a x32 machine.

I have now addressed this issue by amending the following section in the MembersFromEnum function as follows:

VBA Code: 
        lOffset = IIf(PTR_LEN = 4&, 4&, 0&)
        Call CopyMemory(tDUMMYUNIONNAME, ByVal tVARDESC.DUMMYUNIONNAME + lOffset, LenB(tDUMMYUNIONNAME))
        Call CopyMemory(lEnumVal, ByVal VarPtr(tDUMMYUNIONNAME.lpvarValue), PTR_LEN)
        vRet(i).Name = BstrName
        vRet(i).Value = lEnumVal
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
How to export API library from VBA in Excel
Replies
1
Views
183
John_w
J
S
  • Solved
VBA - Overpass default Scripting.Dictionary Keys comparison
Replies
4
Views
104
saboh12617
S
T
  • Question Question
VBA to update Powerpoint Text from Excel Data in Cells
Replies
9
Views
975
tbakbradley
T
A
  • Question Question
Selenium and Excel
Replies
3
Views
337
armsy
A
N
  • Question Question
VBA to add title from formula to a save as name
Replies
0
Views
96
NKUNZI
N

Forum statistics

Threads
1,223,887
Messages
6,175,199
Members
452,617
Latest member
Narendra Babu D

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top