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
Jaafar Tribak said:
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.
Click to expand...

If we look at Object Browser (see below snapshot), any class member can either be Function, Constant, Sub, Property, Enum, or Event, etc., see green arrow below.

In the screen capture below, the example that I chose is the Count function, in the green frame below it appears as Function Count.

With other words, instead of VbLet, VbGet, VbMethod, etc, can you perhaps consider Function, or Constant, or Sub, or Property, or Enum, or Event, etc. in the Member Type\Value column ? These are the designations for the classes members that we can see in the Object Browser. Thank you once again !

1712402428298.png
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
With other words, instead of VbLet, VbGet, VbMethod, etc, can you perhaps consider Function, or Constant, or Sub, or Property, or Enum, or Event, etc
Click to expand...
@RomulusMilea
Ok - I have added a new column to the export-worksheet to show Function, Sub, Property, Enum etc as requested.

Also, while I was at it, I added other extra columns for the members Return Type, Params count, Optional Params count, VTable Offset and DispID. These are also important pieces of information. Once the data is exported on the worksheet, you can filter it by Functions, Properties or whatever.

I have also added a handy "Jump to Class" search box to the browser userform. This should be very useful for quickly finding and locating sought classes in large type libraries. This is a partial match searchbox.

So, here is the final code, hopefully with all the bugs corrected and improved UI.

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
    Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
    Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As LongPtr, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
    Private Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Any, ByVal bErase As Long) As Long
    Private Declare PtrSafe Function SetBkMode Lib "gdi32" (ByVal hDC As LongPtr, ByVal nBkMode As Long) As Long
    Private Declare PtrSafe Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare PtrSafe Function DrawText Lib "user32" Alias "DrawTextW" (ByVal hDC As LongPtr, ByVal lpStr As LongPtr, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    Private Declare PtrSafe Function SetTextColor Lib "gdi32" (ByVal hDC As LongPtr, ByVal crColor As Long) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) 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
    Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As LongPtr, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
    Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Any, ByVal bErase As Long) As Long
    Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As LongPtr, ByVal nBkMode As Long) As Long
    Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function DrawText Lib "user32" Alias "DrawTextW" (ByVal hDC As LongPtr, ByVal lpStr As LongPtr, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As LongPtr, ByVal crColor As Long) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
#End If

Private Type Size
    cx As Long
    cy As Long
End Type

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

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 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

Private hFrame As LongPtr, hDC As LongPtr, hOldFont As LongPtr, lOldBKMode As Long
Private tTextSize1 As Size, tTextSize2 As Size, tTextSize3 As Size
Private tTextRect1 As RECT, tTextRect2 As RECT, tTextRect3 As RECT
Private sWaitMsg1 As String, sWaitMsg2 As String
Private bExportingFinished As Boolean
Private bErrorFlag As Boolean



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, lEnumVal As Long
    Dim pVARDESC  As LongPtr, BstrName As String
    Dim vRet() As ENUM_VALS
    Dim i As Long, lRet As Long, lOffset 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
        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
        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
    oSh.[a2].Font.Size = 14&
    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&) = "Enum"
                            oSh.Cells(Rw, 5&) = 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&) = MemberKindToStandardMemberName(sInvkind, Funcs(j).ReturnType)
                        oSh.Cells(Rw, 5&) = IIf(InStr(sInvkind, "[Event]"), "VbMethod", sInvkind)
                        oSh.Cells(Rw, 6&) = Funcs(j).ReturnType
                        oSh.Cells(Rw, 7&) = Funcs(j).ParamsCount
                        oSh.Cells(Rw, 8&) = Funcs(j).OptParamsCount
                        oSh.Cells(Rw, 9&) = Funcs(j).VTBLOffset
                        oSh.Cells(Rw, 10&) = Funcs(j).memid
                    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&) = "Enum"
                        oSh.Cells(Rw, 5&) = 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

Sub ShowWaitMsg(ByVal Uf As UserForm, ByVal WaitMsg As String)
       
    Const TRANSPARENT = 1&
    Dim X1 As Long, Y1 As Long
    Dim X2 As Long, Y2 As Long
    Dim X3 As Long, Y3 As Long
    Dim W1 As Long, W2 As Long, W3 As Long
    Dim H1 As Long, H2 As Long, H3 As Long
    Dim IFont As stdole.IFont
    Dim tFrameRect As RECT

    sWaitMsg1 = Split(WaitMsg, vbLf)(0&)
    sWaitMsg2 = Split(WaitMsg, vbLf)(1&)
    Call IUnknown_GetWindow(Uf.Frame1, VarPtr(hFrame))
    Call GetClientRect(hFrame, tFrameRect)
    hDC = GetDC(hFrame)
    lOldBKMode = SetBkMode(hDC, TRANSPARENT)
    Set IFont = Uf.btnExportToSheet.Font
    IFont.Size = 16&
    hOldFont = SelectObject(hDC, IFont.hFont)
    IFont.Size = 10&
    Call GetTextExtentPoint32(hDC, sWaitMsg1, Len(sWaitMsg1), tTextSize1)
    Call GetTextExtentPoint32(hDC, sWaitMsg2, Len(sWaitMsg2), tTextSize2)
    Call GetTextExtentPoint32(hDC, vbNullChar, Len(vbNullChar), tTextSize3)
    Call SetTextColor(hDC, vbRed)
    W1 = tTextSize1.cx:   W2 = tTextSize2.cx:  W3 = tTextSize3.cx
    H1 = tTextSize1.cy:   H2 = tTextSize2.cy:  H3 = tTextSize3.cy
    X1 = ((tFrameRect.Right - tFrameRect.Left) - W1) / 2&
    Y1 = ((tFrameRect.Bottom - tFrameRect.Top) - H1) / 3&
    Call SetRect(tTextRect1, X1, Y1, W1 + X1, H1 + Y1)
    X2 = ((tFrameRect.Right - tFrameRect.Left) - W2) / 2&
    Y2 = Y1 + H1
    Call SetRect(tTextRect2, X2, Y2, W2 + X2, H2 + Y2)
    X3 = W2 + X2
    Call SetRect(tTextRect3, X3, Y2, W3 + X3, H3 + Y2)
    bExportingFinished = False
    Call KillTimer(Application.hwnd, NULL_PTR)
    bErrorFlag = True
    Call TimerProc
    Call SetTimer(Application.hwnd, NULL_PTR, 500&, AddressOf TimerProc)
        
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 MemberKindToStandardMemberName( _
    ByVal MembKind As String, _
    ByVal ReturnType As String _
) As String

    Select Case MembKind
        Case Is = "VbLet", "VbGet", "VbSet"
            MemberKindToStandardMemberName = "Property"
        Case "VbMethod"
            If ReturnType = "VOID" Or ReturnType = "HRESULT" Then
                MemberKindToStandardMemberName = "Sub"
            Else
                MemberKindToStandardMemberName = "Function"
            End If
        Case "VbMethod  [Event]"
            MemberKindToStandardMemberName = "Event"
    End Select
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:J1")
            .Cells(1) = "TLB":               .Cells(2) = "ClassName"
            .Cells(3) = "Member":            .Cells(4) = "MemberKind"
            .Cells(5) = "InvKind\Val":       .Cells(6) = "RetType"
            .Cells(7) = "ParamCount":        .Cells(8) = "OptParamCount"
            .Cells(9) = "VTblOffset":        .Cells(10) = "DispID"
            .Interior.Color = &HEED7BD
            .Font.Bold = True
            .Font.Color = vbBlue
            .Font.Size = 14&
            .Borders.LineStyle = xlContinuous
            .Columns("B:I").EntireColumn.AutoFit
            .Columns("D:J").EntireColumn.HorizontalAlignment = xlCenter
            .Range("a2").HorizontalAlignment = xlLeft
            .Cells(1).Offset(2).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
    bExportingFinished = True
    MsgBox "Done exporting the TypeLib to the worksheet.", vbInformation
    
End Sub

Private Sub Release_DC()
    Call SelectObject(hDC, lOldBKMode)
    Call SelectObject(hDC, hOldFont)
    Call ReleaseDC(hFrame, hDC)
End Sub

Private Sub TimerProc()
    
    Const DT_CENTER = &H1
    Static i As Long
    
    If bErrorFlag = False Then
        Call KillTimer(Application.hwnd, NULL_PTR)
        Exit Sub
    End If
    
    Call DrawText(hDC, StrPtr(sWaitMsg1), -1&, tTextRect1, DT_CENTER)
    Call DrawText(hDC, StrPtr(sWaitMsg2), -1&, tTextRect2, DT_CENTER)
    If i Mod 2& Then
        Call DrawText(hDC, StrPtr(" " & ChrW(&H25A0)), -1&, tTextRect3, DT_CENTER)
    Else
        Call InvalidateRect(hFrame, tTextRect3, 0&)
    End If
    If bExportingFinished Then
        bExportingFinished = False:  bErrorFlag = False:  i = 0&
        Call KillTimer(Application.hwnd, NULL_PTR)
        Call InvalidateRect(hFrame, tTextRect1, 0&)
        Call InvalidateRect(hFrame, tTextRect2, 0&)
        Call InvalidateRect(hFrame, tTextRect3, 0&)
        Call Release_DC
    End If
    i = i + 1&

End Sub


2- Browser UserForm Code:
VBA Code: 
Option Explicit

Private ElementType As SEARCH_TARGET
Private sCurLib As String
Private bExporting As Boolean

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_QueryClose(Cancel As Integer, CloseMode As Integer)
    If bExporting Then Cancel = True
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
    
    Me.lblFoundIdx = ""

    '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 = BuildClassInfoValues(GetClassAttributes(sCurLib, lPtr), Me.chkIUnkDisp.Value)
    End If

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

End Sub

Private Sub btnExportToSheet_Click()
    If Len(sCurLib) = 0& Then Exit Sub
    If Not Not tArrays.arrPtrs Then
        If Len(Dir(sCurLib)) And bExporting = False Then
            bExporting = True
            TxtCaptions = "":   TxtValues = ""
            Call ShowWaitMsg(Me, "Exporting in progress" & vbLf & "Please wait")
            Application.ScreenUpdating = False
            Call ExportTLibToSheet(sCurLib)
            Application.ScreenUpdating = True
            bExporting = False
        End If
    Else
        MsgBox "No data to export."
    End If
End Sub

Private Sub btnSearchClass_Click()
    Static idx As Long
    Dim vFoundStrings() As Variant
    Dim sMatch As String
    Dim lFoundIdx As Long, lTotalFound As Long
    
    sMatch = txtSearchClass
    If Len(sMatch) Then
        vFoundStrings = FindStrings(sMatch, ListClasses.List)
        If Not Not vFoundStrings Then
            lTotalFound = UBound(vFoundStrings)
            If lTotalFound = 0& Then
                ListClasses.Selected(vFoundStrings(0&)) = True
            Else
                lFoundIdx = idx Mod UBound(vFoundStrings)
                ListClasses.Selected(vFoundStrings(lFoundIdx)) = True
            End If
            btnSearchClass.Caption = "Next"
            lblFoundIdx = "[" & lFoundIdx + 1 & " of " & lTotalFound & "]"
            idx = idx + 1
        Else
            lblFoundIdx = "Nil"
        End If
    End If
End Sub

Private Sub txtSearchClass_Change()
    btnSearchClass.Caption = "GO"
    Call btnSearchClass_Click
End Sub

Private Function FindStrings(ByVal MatchString As String, List As Variant) As Variant()
    Dim vItm As Variant, idx As Long, n As Long, vFoundArray() As Variant
    If IsArray(List) Then
        For Each vItm In List
            If InStr(1&, vItm, MatchString, vbTextCompare) Then
                ReDim Preserve vFoundArray(n)
                vFoundArray(n) = idx:  n = n + 1&
            End If
            idx = idx + 1&
        Next
    End If
    FindStrings = vFoundArray
End Function

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

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

Thank you for considering those extra columns, now we can easily filter by Function, Enum, Parameter, etc. This is simply fantastic !

I have one question: I have chosen a random class (Button), and I have noticed that some properties are duplicated, see below pictures, items marked in yellow. Each appears on both VbGet, and VbLet.

Is this OK ? The same applies for many other classes. If we compare with Excel Object Browser, these properties appear only 1 time in the list.

Duplicates.png


Another question: Or function is part of the WorksheetFunction class (as per Excel Object Browser), but in the list that I generated with the amazing solution you created that Or function appears under hidden class called |AppEvents, see below picture. Is this OK ?

1712555632379.png


Thank you !

My warmest regards,
Romulus Milea.
 
Upvote 0
a humble suggestion from me:
add two lines and edit one in FormatExportSheet:
VBA Code: 
        .Outline.SummaryRow = xlAbove
        Set oRange = .Range("B5:B" & .UsedRange.Rows.Count)
        ...
        .UsedRange.AutoFilter
so the complete sub is:
VBA Code: 
Private Sub FormatExportSheet(ByVal Sh As Worksheet)
    Dim oRange As Range
    With Sh
        With .Range("A1:J1")
            .Cells(1) = "TLB":               .Cells(2) = "ClassName"
            .Cells(3) = "Member":            .Cells(4) = "MemberKind"
            .Cells(5) = "InvKind\Val":       .Cells(6) = "RetType"
            .Cells(7) = "ParamCount":        .Cells(8) = "OptParamCount"
            .Cells(9) = "VTblOffset":        .Cells(10) = "DispID"
            .Interior.Color = &HEED7BD
            .Font.Bold = True
            .Font.Color = vbBlue
            .Font.Size = 14&
            .Borders.LineStyle = xlContinuous
            .Columns("B:I").EntireColumn.AutoFit
            .Columns("D:J").EntireColumn.HorizontalAlignment = xlCenter
            .Range("a2").HorizontalAlignment = xlLeft
            .Cells(1).Offset(2).Select
            ActiveWindow.FreezePanes = True
            ActiveWindow.Zoom = 90&
        End With
        .Outline.SummaryRow = xlAbove
        Set oRange = .Range("B5:B" & .UsedRange.Rows.Count)
'        Set oRange = .Range("B5:B" & .Range("C" & .UsedRange.Rows.Count + 1).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&
        .UsedRange.AutoFilter
    End With
    bExportingFinished = True
    MsgBox "Done exporting the TypeLib to the worksheet.", vbInformation
End Sub
 
Upvote 0
@RomulusMilea

I have one question: I have chosen a random class (Button), and I have noticed that some properties are duplicated, see below pictures, items marked in yellow. Each appears on both VbGet, and VbLet.
Click to expand...
The Properties are not duplicated . They are in fact the same Property ... Take for example the "Enabled" Property that is at the top of the list on your screenshot. As you rightly said, there is one with VbGet followed by one with VbLet. But if you look at their respective memids in the right-most DispID column, you will notice that they both have the same ID which suggestes they are actually the same Property.

So why are there two entries then? the answer is that VbGet is a READ Property (INVOKE_PROPERTYGET) whereas VbLet is a PUT Property (INVOKE_PROPERTYPUT), each with a different address in the WorksheetFunction Interface virtual table. (See VTblOffset column) ... The VbGet and VbLet entries are separated by 4 bytes in x32 processes and by 8 bytes in x64 processes. (Just by looking at the VTblOffset column on your screen shot, I can tell that you are running a x64bit excel)

Same logic applies to VbSet (It is like VbLet but for Objects)

So all the above simply means that the value of the Enabled Property of the Button Class can be read as well as edited. In other words, you can do this in code :

'Read the Button Enabled Property.
MsgBox Sheet1.Buttons("Button 1").Enabled

And

'Change the Button Enabled Property.
Sheet1.Buttons("Button 1").Enabled = False
Or
Sheet1.Buttons("Button 1").Enabled = True


But there are some Properties which are Read Only. This means that they won't show up as duplicates on the list. there will only be one single entry with VbGet only.

On example of a ReadOnly Property from the list on the screen shot you posted is the Font Property. As you can see, it has no duplicate (no VbLet).

BTW, You can see this in the VBE built-in Object Browser as well:

Untitf8888gled.png


This will make more sense if we consider the Name Property of the Application Class. It is OK to be able to read the Name Property of the Application but it would make no sense to be able to change it to other than "Microsoft Excel". That's why The Application Name Property is VbGet only (ie; Read Only)


Another question: Or function is part of the WorksheetFunction class (as per Excel Object Browser), but in the list that I generated with the amazing solution you created that Or function appears under hidden class called |AppEvents, see below picture. Is this OK ?
Click to expand...

I think you must have clicked on the wrong + worksheet grouping button or something with your filtering because the Or function appears correctly for me under the WorksheetFunction Interface as expected:

Untiftled.png
 
Upvote 0
Jaafar Tribak said:
I think you must have clicked on the wrong + worksheet grouping button or something with your filtering because the Or function appears correctly for me under the WorksheetFunction Interface as expected:
Click to expand...
to avoid any confusion with the grouping I think it's best to use this:
VBA Code: 
sh.Outline.SummaryRow = xlAbove
(see my post 24 above)
p.s.: I didn't explain in my previous post, but the reason for modifying oRange definition is that otherwise the last items remained not grouped.
 
Upvote 0
bobsan42 said:
a humble suggestion from me:
add two lines and edit one in FormatExportSheet:
VBA Code: 
        .Outline.SummaryRow = xlAbove
        Set oRange = .Range("B5:B" & .UsedRange.Rows.Count)
        ...
        .UsedRange.AutoFilter
Click to expand...
Excellent addition bobsan42 !

I think the abscence of Outline.SummaryRow = xlAbove is what was causing the problem to the OP.
And the Autofilter was the icing on the cake :)

I have just updated the workbook in the link with your suggestions

Thank you.

PS:
@RomulusMilea
Please, download the latest wokbook update which includes bobsan42's suggestions)

Latest Update:
VBA_Custom_ObjBrowser.xlsm
 
Last edited:
Upvote 0
UPDATE:

I have added two new columns, one for the Member Entry Point (ITypeInfo::GetDllEntry) for STATIC functions and one for Hidden Members. (FUNCFLAG_FHIDDEN) as initially requested by the OP.

I have also rewritten the EVENTS handling logic.

Untitlehgjd.png



I have already updated the workbook in the link:
VBA_Custom_ObjBrowser.xlsm


Allright, so this is the code I have settled on :

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
    Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
    Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As LongPtr, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
    Private Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Any, ByVal bErase As Long) As Long
    Private Declare PtrSafe Function SetBkMode Lib "gdi32" (ByVal hDC As LongPtr, ByVal nBkMode As Long) As Long
    Private Declare PtrSafe Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare PtrSafe Function DrawText Lib "user32" Alias "DrawTextW" (ByVal hDC As LongPtr, ByVal lpStr As LongPtr, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    Private Declare PtrSafe Function SetTextColor Lib "gdi32" (ByVal hDC As LongPtr, ByVal crColor As Long) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) 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
    Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As LongPtr, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
    Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Any, ByVal bErase As Long) As Long
    Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As LongPtr, ByVal nBkMode As Long) As Long
    Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function DrawText Lib "user32" Alias "DrawTextW" (ByVal hDC As LongPtr, ByVal lpStr As LongPtr, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As LongPtr, ByVal crColor As Long) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
#End If

Public Type FUNC_INFO
    Name As String
    memid As Long
    CallConvention As Long
    funckind As Long
    VTBLOffset As Long
    EntryPoint As Integer
    INVOKEKIND As String
    ParamsCount As Long
    OptParamsCount As Long
    ReturnType As String
    IsHidden As Boolean
    wFuncFlags As Long
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 Size
    cx As Long
    cy As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0& To 7&) As Byte
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 Long
End Type

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

Private Type INFO
    CI() As INTERFACE_INFO
    II() 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
End Type

Public tArrays As ARRAYS

Private hFrame As LongPtr, hDC As LongPtr, hOldFont As LongPtr, lOldBKMode As Long
Private tTextSize1 As Size, tTextSize2 As Size, tTextSize3 As Size
Private tTextRect1 As RECT, tTextRect2 As RECT, tTextRect3 As RECT
Private sWaitMsg1 As String, sWaitMsg2 As String
Private bExportingFinished As Boolean
Private bErrorFlag As Boolean


Function RetrieveLibInfo(ByVal sFile As String) As Boolean

    Dim lArrRows As Long, i As Long
    
    Call EraseArrays
    
    With tArrays
    
        .arrInterfaces = TypeInfoFromCOMLib(sFile, II).II
        If Not Not .arrInterfaces Then
            For i = LBound(.arrInterfaces) To UBound(.arrInterfaces)
                ReDim Preserve .arrNames(lArrRows)
                ReDim Preserve .arrPtrs(lArrRows)
                ReDim Preserve .arrTypes(lArrRows)
                ReDim Preserve .arrOtherInfo1(lArrRows)
                ReDim Preserve .arrOtherInfo2(lArrRows)
                .arrNames(lArrRows) = ChrW(&H25A0) & " " & .arrInterfaces(i).Name
                .arrPtrs(lArrRows) = .arrInterfaces(i).Ptr
                .arrTypes(lArrRows) = Interface_
                .arrOtherInfo1(lArrRows) = BuildClassInfoString(.arrInterfaces(i), False)
                .arrOtherInfo2(lArrRows) = BuildClassInfoString(.arrInterfaces(i), True)
                lArrRows = lArrRows + 1&
            Next i
        End If
    
        .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 i
        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()
    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_INTERFACE = 3&, TKIND_DISPATCH = 4&, TKIND_MODULE = 2&, TKIND_ENUM = 0&
    Const S_OK = 0&, CC_STDCALL = 4&
    Dim pTKind As LongPtr, ppTInfo As LongPtr, farPtr As LongPtr, psGUID As LongPtr
    Dim tInterfaceInfo 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 = II
                    ReDim Preserve tInfoArray.II(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, vbLong, 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_INTERFACE
                    With tInterfaceInfo
                        .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.II(j) = tInterfaceInfo
                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 TInfoName As String, _
    Optional ByVal FuncCallType As VbCallType, _
    Optional ByVal unk As Boolean _
) As FUNC_INFO()
    
    Const CC_STDCALL = 4&, S_OK = 0&, FUNCFLAG_FHIDDEN = &H40, FUNC_DISPATCH = 4&, INVOKE_FUNC = 1&
    Dim aTYPEATTR() 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
    Dim pwOrdinal As Integer
    Dim IsMemberHidden As Boolean
    
    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))
            lRet = vtblCall(ppTInfo, 20& * PTR_LEN, vbEmpty, CC_STDCALL, farPtr) 'ITypeInfo::ReleaseFuncDesc
            lRet = vtblCall(ppTInfo, 12& * PTR_LEN, vbLong, CC_STDCALL, tFuncDesc.memid, 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
            IsMemberHidden = CBool((tFuncDesc.wFuncFlags And FUNCFLAG_FHIDDEN) = FUNCFLAG_FHIDDEN)
            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 .funckind = FUNC_DISPATCH And InStr(TInfoName, "Events") 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)
                    tFuncDescArray(n).IsHidden = IsMemberHidden
                    lRet = vtblCall(ppTInfo, 13& * PTR_LEN, vbLong, CC_STDCALL, tFuncDesc.memid, tFuncDesc.INVOKEKIND, NULL_PTR, NULL_PTR, VarPtr(pwOrdinal))  'ITypeInfo::GetDllEntry
                    If lRet = S_OK Then
                        tFuncDescArray(n).EntryPoint = pwOrdinal
                    End If
                    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, lEnumVal As Long
    Dim pVARDESC  As LongPtr, BstrName As String
    Dim vRet() As ENUM_VALS
    Dim i As Long, lRet As Long, lOffset 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, 21& * PTR_LEN, vbEmpty, CC_STDCALL, pVARDESC) 'ITypeInfo::ReleaseVarDesc
        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
        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
        MembersFromEnum = vRet
    Next i

End Function

Function BuildFuncInfoString(INFO As FUNC_INFO) As TEXT_STRUCT
    Dim tString As TEXT_STRUCT, sFuncKind As String
    With INFO
        sFuncKind = Switch(.funckind = 0&, "FUNC_VIRTUAL", .funckind = 1&, "FUNC_PUREVIRTUAL", _
        .funckind = 2&, "FUNC_NONVIRTUAL", .funckind = 3&, "FUNC_STATIC", .funckind = 4&, "FUNC_DISPATCH")
    End With
    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 & _
            sFuncKind & vbLf & _
            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 Funcs() As FUNC_INFO, Enums() As ENUM_VALS, lPtr As LongPtr
    Dim tSPECIAL_ENUMS As SPECIAL_ENUMS
    Dim oSh As Worksheet
    Dim sDecoration As String, sInvkind As String
    Dim IsEvent As Boolean
    Dim sPrevEnum As String
    Dim i As Long, j As Long, Rw As Long
    Dim sShName As String

    If RetrieveLibInfo(sLib) = False Then GoTo Xit
    
    Set oSh = Sheets.Add(, ActiveSheet)
    sShName = "_Exported " & Right(sLib, Len(sLib) - InStrRev(sLib, "\", -1&)) & "_" & Sheets.Count
    If Len(sShName) > 31& Then
        sShName = Replace(sShName, "_Exported ", "")
    End If
    oSh.Name = sShName
    oSh.[a2] = "* " & sLib
    oSh.[a2].Font.Size = 14&
    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 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&) = "Enum"
                            oSh.Cells(Rw, 5&) = tSPECIAL_ENUMS.Value(j)
                        Next j
                    End If
                End If
            
                Funcs = GetFuncs( _
                    lPtr, _
                    .arrNames(i), _
                    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
                        With oSh
                            .Cells(Rw, 3&) = sDecoration & Funcs(j).Name
                            .Cells(Rw, 4&) = MemberKindToStandardMemberName(sInvkind, Funcs(j).ReturnType)
                            .Cells(Rw, 5&) = IIf(InStr(sInvkind, "[Event]"), "VbMethod", sInvkind)
                            .Cells(Rw, 6&) = Funcs(j).ReturnType
                            .Cells(Rw, 7&) = Funcs(j).ParamsCount
                            .Cells(Rw, 8&) = Funcs(j).OptParamsCount
                            .Cells(Rw, 9&) = Funcs(j).VTBLOffset
                            .Cells(Rw, 10&) = Funcs(j).EntryPoint
                            .Cells(Rw, 11&) = Funcs(j).IsHidden
                            .Cells(Rw, 12&) = Funcs(j).memid
                        End With
                    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&) = "Enum"
                        oSh.Cells(Rw, 5&) = 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

Sub ShowWaitMsg(ByVal Uf As UserForm, ByVal WaitMsg As String)
      
    Const TRANSPARENT = 1&
    Dim X1 As Long, Y1 As Long
    Dim X2 As Long, Y2 As Long
    Dim X3 As Long, Y3 As Long
    Dim W1 As Long, W2 As Long, W3 As Long
    Dim H1 As Long, H2 As Long, H3 As Long
    Dim IFont As stdole.IFont
    Dim tFrameRect As RECT

    sWaitMsg1 = Split(WaitMsg, vbLf)(0&)
    sWaitMsg2 = Split(WaitMsg, vbLf)(1&)
    Call IUnknown_GetWindow(Uf.Frame1, VarPtr(hFrame))
    Call GetClientRect(hFrame, tFrameRect)
    hDC = GetDC(hFrame)
    lOldBKMode = SetBkMode(hDC, TRANSPARENT)
    Set IFont = Uf.btnExportToSheet.Font
    IFont.Size = 16&
    hOldFont = SelectObject(hDC, IFont.hFont)
    IFont.Size = 10&
    Call GetTextExtentPoint32(hDC, sWaitMsg1, Len(sWaitMsg1), tTextSize1)
    Call GetTextExtentPoint32(hDC, sWaitMsg2, Len(sWaitMsg2), tTextSize2)
    Call GetTextExtentPoint32(hDC, vbNullChar, Len(vbNullChar), tTextSize3)
    Call SetTextColor(hDC, vbRed)
    W1 = tTextSize1.cx:   W2 = tTextSize2.cx:  W3 = tTextSize3.cx
    H1 = tTextSize1.cy:   H2 = tTextSize2.cy:  H3 = tTextSize3.cy
    X1 = ((tFrameRect.Right - tFrameRect.Left) - W1) / 2&
    Y1 = ((tFrameRect.Bottom - tFrameRect.Top) - H1) / 3&
    Call SetRect(tTextRect1, X1, Y1, W1 + X1, H1 + Y1)
    X2 = ((tFrameRect.Right - tFrameRect.Left) - W2) / 2&
    Y2 = Y1 + H1
    Call SetRect(tTextRect2, X2, Y2, W2 + X2, H2 + Y2)
    X3 = W2 + X2
    Call SetRect(tTextRect3, X3, Y2, W3 + X3, H3 + Y2)
    bExportingFinished = False
    Call KillTimer(Application.hwnd, NULL_PTR)
    bErrorFlag = True
    Call TimerProc
    Call SetTimer(Application.hwnd, NULL_PTR, 500&, AddressOf TimerProc)
        
End Sub


' ______________________________________ PRIVATE SUBS _______________________________________________


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 MemberKindToStandardMemberName( _
    ByVal MembKind As String, _
    ByVal ReturnType As String _
) As String

    Select Case MembKind
        Case Is = "VbLet", "VbGet", "VbSet"
            MemberKindToStandardMemberName = "Property"
        Case "VbMethod"
            If ReturnType = "VOID" Or ReturnType = "HRESULT" Then
                MemberKindToStandardMemberName = "Sub"
            Else
                MemberKindToStandardMemberName = "Function"
            End If
        Case "VbMethod  [Event]"
            MemberKindToStandardMemberName = "Event"
    End Select
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 = "LongPtr"
        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:L1")
            .Cells(1) = "TLB":                .Cells(2) = "ClassName"
            .Cells(3) = "Member":             .Cells(4) = "Kind"
            .Cells(5) = "Invkind||Val":       .Cells(6) = "RetType"
            .Cells(7) = "cParams":            .Cells(8) = "cOptParams"
            .Cells(9) = "oVft":               .Cells(10) = "EntryPnt"
            .Cells(11) = "Hidden":            .Cells(12) = "DispID"
            .Interior.Color = &HEED7BD
            .Font.Bold = True
            .Font.Color = vbBlue
            .Font.Size = 14&
            .Borders.LineStyle = xlContinuous
            .Columns("D:L").EntireColumn.HorizontalAlignment = xlCenter
            .Range("a2").HorizontalAlignment = xlLeft
            .Cells(1).Offset(2).Select
            ActiveWindow.FreezePanes = True
            ActiveWindow.Zoom = 70&
        End With
        .Outline.SummaryRow = xlAbove
        Set oRange = .Range("B5:B" & .UsedRange.Rows.Count)
        Set oRange = oRange.SpecialCells(xlCellTypeBlanks)
        Dim oArea  As Variant
        For Each oArea In oRange.Areas
            oArea.Rows.Group
        Next
        .Outline.ShowLevels RowLevels:=2&
        .UsedRange.AutoFilter
        .Columns("B:L").EntireColumn.AutoFit
    End With
    bExportingFinished = True
    MsgBox "Done exporting the TypeLib to the worksheet.", vbInformation
End Sub

Private Sub Release_DC()
    Call SelectObject(hDC, lOldBKMode)
    Call SelectObject(hDC, hOldFont)
    Call ReleaseDC(hFrame, hDC)
End Sub

Private Sub TimerProc()
    
    Const DT_CENTER = &H1
    Static i As Long
    
    If bErrorFlag = False Then
        Call KillTimer(Application.hwnd, NULL_PTR)
        Exit Sub
    End If
    
    Call DrawText(hDC, StrPtr(sWaitMsg1), -1&, tTextRect1, DT_CENTER)
    Call DrawText(hDC, StrPtr(sWaitMsg2), -1&, tTextRect2, DT_CENTER)
    If i Mod 2& Then
        Call DrawText(hDC, StrPtr(" " & ChrW(&H25A0)), -1&, tTextRect3, DT_CENTER)
    Else
        Call InvalidateRect(hFrame, tTextRect3, 0&)
    End If
    If bExportingFinished Then
        bExportingFinished = False:  bErrorFlag = False:  i = 0&
        Call KillTimer(Application.hwnd, NULL_PTR)
        Call InvalidateRect(hFrame, tTextRect1, 0&)
        Call InvalidateRect(hFrame, tTextRect2, 0&)
        Call InvalidateRect(hFrame, tTextRect3, 0&)
        Call Release_DC
    End If
    i = i + 1&

End Sub


2- Code in the Browser UserForm Module:
VBA Code: 
Option Explicit

Private ElementType As SEARCH_TARGET
Private sCurLib As String
Private bExporting As Boolean


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_QueryClose(Cancel As Integer, CloseMode As Integer)
    If bExporting Then Cancel = True
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 sCurrentInterface As String
    Dim sDecoration As String, i As Long
    Dim IsEvent As Boolean
    
    If ListClasses.ListIndex = -1& Then Exit Sub
    
    ListMembers.Clear
    Me.lblFoundIdx = ""

    '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)
        lPtr = .arrPtrs(ListClasses.ListIndex)
        
        'retrieve all members\funcs.
        Funcs = GetFuncs( _
            lPtr, _
            ListClasses.Value, _
            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 = BuildClassInfoValues(GetClassAttributes(sCurLib, lPtr), Me.chkIUnkDisp.Value)
    End If

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

End Sub

Private Sub btnExportToSheet_Click()
    If Len(sCurLib) = 0& Then Exit Sub
    If Not Not tArrays.arrPtrs Then
        If Len(Dir(sCurLib)) And bExporting = False Then
            bExporting = True
            TxtCaptions = "":   TxtValues = ""
            Call ShowWaitMsg(Me, "Exporting in progress" & vbLf & "Please wait")
            Application.ScreenUpdating = False
            Call ExportTLibToSheet(sCurLib)
            Application.ScreenUpdating = True
            bExporting = False
        End If
    Else
        MsgBox "No data to export."
    End If
End Sub

Private Sub btnSearchClass_Click()
    Call DoSearch
End Sub

Private Sub txtSearchClass_Change()
    btnSearchClass.Caption = "GO"
    Call DoSearch
End Sub

Private Sub txtSearchClass_Enter()
    btnSearchClass.Caption = "GO"
    Call DoSearch
End Sub

Private Sub DoSearch()
    Static idx As Long
    Dim vFoundStrings() As Variant
    Dim sMatch As String
    Dim lFoundIdx As Long, lTotalFound As Long
    
    sMatch = txtSearchClass.Text
    If Len(sMatch) Then
        vFoundStrings = FindStrings(sMatch, ListClasses.List)
        If Not Not vFoundStrings Then
            lTotalFound = UBound(vFoundStrings) + 1
            If lTotalFound = 0& Then
                ListClasses.Selected(vFoundStrings(0&)) = True
            Else
                lFoundIdx = idx Mod (UBound(vFoundStrings) + 1)
                ListClasses.Selected(vFoundStrings(lFoundIdx)) = True
            End If
            btnSearchClass.Caption = "Next"
            lblFoundIdx = "[" & lFoundIdx + 1 & " of " & lTotalFound & "]"
            idx = idx + 1
        Else
            lblFoundIdx = "Nil"
        End If
    Else
        lblFoundIdx = ""
    End If
End Sub

Private Function FindStrings(ByVal MatchString As String, List As Variant) As Variant()
    Dim vItm As Variant, idx As Long, n As Long, vFoundArray() As Variant
    If IsArray(List) Then
        For Each vItm In List
            If InStr(1&, vItm, MatchString, vbTextCompare) Then
                ReDim Preserve vFoundArray(n)
                vFoundArray(n) = idx:  n = n + 1&
            End If
            idx = idx + 1&
        Next
    End If
    FindStrings = vFoundArray
End Function

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

Private Function BuildClassInfoValues(INFO As INTERFACE_INFO, bShowUnkDisp As Boolean) As String
        If ElementType <> Enum_ Then
            BuildClassInfoValues = _
                INFO.Name & vbLf & _
                IIf(bShowUnkDisp, INFO.MembersCount, ListMembers.ListCount) & vbLf & _
                INFO.GUID & vbLf & _
                INFO.LCID & vbLf & _
                INFO.Ptr
        End If
End Function
 
Upvote 0
Amazing code, as always, Jaafar. You must have put a lot of effort into writing and testing it.

I've written the code below which uses UIAutomation to scrape the Object Browser and output the details to a sheet. It captures Classes and Members, including Sub and Function parameters, plus other details, from multiple libraries. It captures hidden members if you display them before running the macro, however it can't determine if a member is hidden or not, because this information is not available in the Object Browser's UI elements. It's obviously a lot slower than Jaafar's code.

Example output:

UIAutomation VBA Object Browser.xlsm
ABCDEFGHIJKLM
1LibraryFileReferenceClassTypeDetailMemberTypeDetailRead onlyMember ofDefault MemberDescription
2ExcelRangeClassActivateFunctionFunction Activate()Excel.Range
3ExcelRangeClassAddCommentFunctionFunction AddComment([Text]) As CommentExcel.Range
4ExcelRangeClassAddCommentThreadedFunctionFunction AddCommentThreaded(Text As String) As CommentThreadedExcel.Range
5ExcelRangeClassAddIndentPropertyProperty AddIndent As VariantExcel.Range
6ExcelRangeClassAddressPropertyProperty Address([RowAbsolute], [ColumnAbsolute], [ReferenceStyle As XlReferenceStyle = xlA1], [External], [RelativeTo]) As StringYExcel.Range
7ExcelRangeClassAddressLocalPropertyProperty AddressLocal([RowAbsolute], [ColumnAbsolute], [ReferenceStyle As XlReferenceStyle = xlA1], [External], [RelativeTo]) As StringYExcel.Range
8ExcelRangeClassAdvancedFilterFunctionFunction AdvancedFilter(Action As XlFilterAction, [CriteriaRange], [CopyToRange], [Unique])Excel.Range
9ExcelRangeClassAllocateChangesSubSub AllocateChanges()Excel.Range
10ExcelRangeClassAllowEditPropertyProperty AllowEdit As BooleanYExcel.Range
11ExcelRangeClassApplicationPropertyProperty Application As ApplicationYExcel.Range
12ExcelRangeClassApplyNamesFunctionFunction ApplyNames([Names], [IgnoreRelativeAbsolute], [UseRowColumnNames], [OmitColumn], [OmitRow], [Order As XlApplyNamesOrder = xlRowThenColumn], [AppendLast])Excel.Range
13ExcelRangeClassApplyOutlineStylesFunctionFunction ApplyOutlineStyles()Excel.Range
14ExcelRangeClassAreasPropertyProperty Areas As AreasYExcel.Range
15ExcelRangeClassAutoCompleteFunctionFunction AutoComplete(String As String) As StringExcel.Range
16ExcelRangeClassAutoFillFunctionFunction AutoFill(Destination As Range, [Type As XlAutoFillType = xlFillDefault])Excel.Range
17ExcelRangeClassAutoFilterFunctionFunction AutoFilter([Field], [Criteria1], [Operator As XlAutoFilterOperator = xlAnd], [Criteria2], [VisibleDropDown], [SubField])Excel.Range
18ExcelRangeClassAutoFitFunctionFunction AutoFit()Excel.Range
19ExcelRangeClassAutoOutlineFunctionFunction AutoOutline()Excel.Range
20ExcelRangeClassBorderAroundFunctionFunction BorderAround([LineStyle], [Weight As XlBorderWeight = xlThin], [ColorIndex As XlColorIndex = xlColorIndexAutomatic], [Color], [ThemeColor])Excel.Range
UI debug


The code requires a reference to UIAutomationClient.

Module1 - the macro, This_Object_Browser, must be run from the Object Browser window. Additionally, the destination sheet, "Object Browser", must exist in the macro workbook.

VBA Code: 
'References required:
'UIAutomationClient


Option Explicit

Public Sub This_Object_Browser()
    
    #If VBA7 Then
        Dim ObjectBrowserHwnd As LongPtr
    #Else
        Dim ObjectBrowserHwnd As Long
    #End If
    Dim destSheet As Worksheet
    Dim findCaption As String
    Dim libraries As String
        
    Set destSheet = ThisWorkbook.Worksheets("Object Browser")
    
    'Libraries to be scraped
    
    libraries = ""  'all libraries
    libraries = "Excel,stdole,UIAutomationClient"
    
    findCaption = "*" & ThisWorkbook.Name & "*[Object Browser]"
    ObjectBrowserHwnd = Find_Object_Browser_Window(findCaption)
    
    If ObjectBrowserHwnd <> 0 Then
        Debug.Print "hWnd: " & ObjectBrowserHwnd
        Debug.Print findCaption
        Automate_Object_Browser ObjectBrowserHwnd, libraries, destSheet
    Else
        Debug.Print "This macro must be run from the Object Browser"
    End If
        
End Sub

Module2 - UIAutomation code

VBA Code: 
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If


#If VBA7 Then
Public Function Find_Object_Browser_Window(ByRef findCaptionLike As String) As LongPtr
#Else
Public Function Find_Object_Browser_Window(ByRef findCaptionLike As String) As Long
#End If
   
    'Find the Object Browser window and return its window handle and full caption

    Dim UIAuto As IUIAutomation
    Dim Desktop As IUIAutomationElement
    Dim ControlTypeAndNameCond As IUIAutomationCondition
    Dim WindowPattern As IUIAutomationWindowPattern
    Dim OBwindow As IUIAutomationElement
    Dim VBEwindows As IUIAutomationElementArray
    Dim VBEwindow As IUIAutomationElement
    Dim captionLike As String
    Dim i As Long
    
    Find_Object_Browser_Window = 0

    'The Like pattern "[charlist]" matches any character in charlist.  To prevent the Like operator interpreting "[Object Browser]" as a charlist,
    'enclose the left bracket "[" in brackets so that the "[" matches a literal "[".  With "[[]" now in the pattern, the right bracket "]" in the pattern is not
    'treated as a special character and matches a literal "]"
    
    captionLike = Replace(findCaptionLike, "[", "[[]")
    
    'Create UIAutomation object
    
    Set UIAuto = New CUIAutomation
    
    'Find VBE windows on Desktop
    'Name:          "<workbook name>.xlsm - [Object Browser]"
    'ControlType:   UIA_WindowControlTypeId
    'ClassName:     "wndclass_desked_gsk"
    
    With UIAuto
        Set Desktop = .GetRootElement
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_WindowControlTypeId), _
                                                         .CreatePropertyCondition(UIA_ClassNamePropertyId, "wndclass_desked_gsk"))
                                                         
    End With
    Set VBEwindows = Desktop.FindAll(TreeScope_Children, ControlTypeAndNameCond)
    
    i = 0
    While i < VBEwindows.Length And Find_Object_Browser_Window = 0
        Set VBEwindow = VBEwindows.GetElement(i)
        Debug.Print "Name: " & VBEwindow.CurrentName
        If LCase(VBEwindow.CurrentName) Like LCase(captionLike) Then
            'Matching caption found, so return full caption and handle
            findCaptionLike = VBEwindow.CurrentName
            Find_Object_Browser_Window = VBEwindow.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
        End If
        i = i + 1
    Wend
    
End Function


Public Sub Automate_Object_Browser(OBhwnd As LongPtr, libraries As String, destSheet As Worksheet)

    Dim UIAuto As IUIAutomation
    Dim OBwindow As IUIAutomationElement
    Dim ControlTypeAndNameCond As IUIAutomationCondition
    Dim ControlTypeCond As IUIAutomationCondition
    Dim librariesCombo As IUIAutomationElement
    Dim librariesComboExpColPattern As IUIAutomationExpandCollapsePattern
    Dim OpenButton As IUIAutomationElement
    Dim OpenPattern As IUIAutomationLegacyIAccessiblePattern
    Dim librariesList As IUIAutomationElement
    Dim librariesListArray As IUIAutomationElementArray
    Dim librariesListItem As IUIAutomationElement
    Dim libraryItemSelectPattern As IUIAutomationSelectionItemPattern
    Dim OBpane As IUIAutomationElement
    Dim panesArray As IUIAutomationElementArray
    Dim classesList As IUIAutomationElement
    Dim classesItemsArray As IUIAutomationElementArray
    Dim classItemSelectPattern As IUIAutomationSelectionItemPattern
    Dim classItemPatternLegacy As IUIAutomationLegacyIAccessiblePattern
    Dim classItem As IUIAutomationElement
    Dim membersList As IUIAutomationElement
    Dim membersItemsArray As IUIAutomationElementArray
    Dim memberItemSelectPattern As IUIAutomationSelectionItemPattern
    Dim memberItemPatternLegacy As IUIAutomationLegacyIAccessiblePattern
    Dim membersItem As IUIAutomationElement
    Dim detailsDocument As IUIAutomationElement
    Dim detailsDocumentTextPattern As IUIAutomationTextPattern
    
    Dim libraryLines As Variant
    Dim library As Variant, foundLibrary As Boolean
    Dim classLines As Variant, classLine1 As String
    Dim memberLines As Variant, memberLine1 As String
    Dim i As Long, r As Long
    Dim c As Long, m As Long

    With destSheet
        .Activate
        .Cells.Delete
        .Range("A1:M1").Value = Array("Library", "File", "Reference", "Class", "Type", "Detail", "Member", "Type", "Detail", "Read only", "Member of", "Default Member", "Description")
        .Rows("1:1").RowHeight = 25
        .UsedRange.AutoFilter
    End With
        
    'Freeze row 1
    
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With

    'Get the Object Browser automation element from its window handle
    
    Set UIAuto = New CUIAutomation
    Set OBwindow = UIAuto.ElementFromHandle(ByVal OBhwnd)
    
    'Find Libraries combo box
    'Name:          "Libraries"
    'ControlType:   UIA_ComboBoxControlTypeId (0xC353)
    
    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ComboBoxControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Libraries"))
    End With
    Set librariesCombo = OBwindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
    
    'Ensure the combo box is collapsed (closed)
    
    Set librariesComboExpColPattern = librariesCombo.GetCurrentPattern(UIA_ExpandCollapsePatternId)
    librariesComboExpColPattern.Collapse
    
    'Find the Combo box child Open button (down arrow)
    'Name:                              "Open"
    'ControlType:                       UIA_ButtonControlTypeId (0xC350)
    'LegacyIAccessible.DefaultAction:   "Open"
    
    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Open"))
    End With
    Set OpenButton = librariesCombo.FindFirst(TreeScope_Children, ControlTypeAndNameCond)
    
    'Get pattern for clicking Open button
    
    Set OpenPattern = OpenButton.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
        
    'Expand the Libraries combo box, so that list items can be found
    
    librariesComboExpColPattern.Expand
    
    'Find list in Libraries combo box
    'Name:          "Libraries"
    'ControlType:   UIA_ListControlTypeId (0xC358)

    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Libraries"))
    End With
    Set librariesList = librariesCombo.FindFirst(TreeScope_Children, ControlTypeAndNameCond)
    
    'Get array of all items in Libraries list
    'ControlType:    UIA_ListItemControlTypeId (0xC357)

    With UIAuto
        Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
    End With
    Set librariesListArray = librariesList.FindAll(TreeScope_Children, ControlTypeCond)
        
    'If no libraries specified, construct list of all libraries except "<All Libraries>" from libraries combo box list
    
    If libraries = "" Then
        For i = 1 To librariesListArray.Length - 1  'start at 1 to omit the <All Libraries> item
            libraries = libraries & librariesListArray.GetElement(i).CurrentName & ","
        Next
        libraries = left(libraries, Len(libraries) - 1)
    End If
    
    'Get Object Browser pane
    'Name:          "Object Browser"
    'ControlType:   UIA_PaneControlTypeId (0xC371)

    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_PaneControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Object Browser"))
    End With
    Set OBpane = OBwindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)

    'Get the 4 sub-panes within the Object Browser pane: Search Results (not read by this macro); Classes; Members; Details
    'ControlType:    UIA_PaneControlTypeId (0xC371)
    
    With UIAuto
        Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_PaneControlTypeId)
    End With
    Set panesArray = OBpane.FindAll(TreeScope_Children, ControlTypeCond)
    
    'Loop through specified libraries and output members to sheet cells
    
    r = 2 'output starts at row 2 in sheet, below row 1 column headings
    
    For Each library In Split(libraries, ",")
    
        'Find this library in the Libraries combobox list
        
        foundLibrary = False
        For i = 1 To librariesListArray.Length - 1   'start at 1 to omit the <All Libraries> item
            Set librariesListItem = librariesListArray.GetElement(i)
            If librariesListItem.CurrentName = library Then
                Debug.Print "Found library: " & librariesListItem.CurrentName
                foundLibrary = True
                Exit For
            End If
        Next
        
        If foundLibrary Then
                    
            'Select this Library item, causing the Library combobox to scroll to it, if necessary
           
            Set libraryItemSelectPattern = librariesListItem.GetCurrentPattern(UIA_SelectionItemPatternId)
            libraryItemSelectPattern.Select
            DoEvents

            'Click Open button to open and expand Libraries combo box

            OpenPattern.DoDefaultAction
            DoEvents

            'Get the listbox within the Classes pane
            
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListControlTypeId)
            End With
            Set classesList = panesArray.GetElement(1).FindFirst(TreeScope_Descendants, ControlTypeCond)
            
            'Get array of items in the Classes listbox
            'ControlType:   UIA_ListItemControlTypeId (0xC357)
    
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
            End With
            Set classesItemsArray = classesList.FindAll(TreeScope_Descendants, ControlTypeCond)
            Debug.Print classesItemsArray.Length & " classes"
                
            'Get the document within the Details pane
            'Name:          "RichEdit Control"
            'ControlType:   UIA_DocumentControlTypeId (0xC36E)
            
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_DocumentControlTypeId)
            End With
            Set detailsDocument = panesArray.GetElement(3).FindFirst(TreeScope_Descendants, ControlTypeCond)
                        
            'Read Details text and write Library details to cells
            
            Set detailsDocumentTextPattern = detailsDocument.GetCurrentPattern(UIA_TextPattern2Id)
            libraryLines = Split(detailsDocumentTextPattern.DocumentRange.GetText(600), vbCr)
            destSheet.Cells(r, "A").Value = librariesListItem.CurrentName   'Library name
            destSheet.Cells(r, "B").Value = Trim(libraryLines(1))           'Library file path
            destSheet.Cells(r, "C").Value = Trim(libraryLines(2))           'Library reference
            r = r + 1
            
            'Loop through each Class in this Library
            
            For c = 0 To classesItemsArray.Length - 1
            
                Set classItem = classesItemsArray.GetElement(c)
                
                'Select this Class, causing the Classes pane to scroll to it, if necessary
            
                Set classItemSelectPattern = classItem.GetCurrentPattern(UIA_SelectionItemPatternId)
                classItemSelectPattern.Select
                DoEvents
    
                'Click this Class to make its Members appear in the Members pane
                
                Set classItemPatternLegacy = classItem.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
                classItemPatternLegacy.DoDefaultAction
                DoEvents
                Sleep 10
    
                'Extract details for this Class
                
                With UIAuto
                    Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_DocumentControlTypeId)
                End With
                Set detailsDocument = panesArray.GetElement(3).FindFirst(TreeScope_Children, ControlTypeCond)
                Set detailsDocumentTextPattern = detailsDocument.GetCurrentPattern(UIA_TextPattern2Id)
                classLines = Split(detailsDocumentTextPattern.DocumentRange.GetText(600), vbCr)
                classLine1 = classLines(0)
                
                'Get Members listbox from the Members pane
                
                With UIAuto
                    Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListControlTypeId)
                End With
                Set membersList = panesArray.GetElement(2).FindFirst(TreeScope_Descendants, ControlTypeCond)
                
                'Get all the items in the Members listbox
                
                With UIAuto
                    Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
                End With
                Set membersItemsArray = membersList.FindAll(TreeScope_Descendants, ControlTypeCond)
                
                If membersItemsArray.Length > 0 Then
                
                    'Loop through each item in the Members listbox, i.e. each Member of this Class
                    
                    For m = 0 To membersItemsArray.Length - 1
                    
                        'Note: the actual Class name as it appears in the Classes listbox is not directly available in the UIAutomation element.
                        'Instead, the Class name is contained in the control name string of the Classes listbox list item.  For Class names,
                        'the control name of each list item is always "Classes <className>" and therefore the Class name is after the word "Classes "
                        'and can be easily extracted.
                        '
                        'Similarly, the actual Member name as it appears in the Members listbox is not directly available in the UIAutomation element.
                        'Instead, the Member name is contained in the control name string of the Members listbox list item.  For Member names,
                        'the control name of each list item is always "Members of '<className>' <memberName>" and therefore the Member name is after
                        'the "' " and can be easily extracted.
                        
                        'Examples (stdole library)
                        '
                        'Classes listbox        List item control name                  Class name extracted
                        '<globals>              "Classes <globals>"                     <globals>
                        'IFontDisp              "Classes IFontDisp"                     IFontDisp
                        '
                        'Members listbox        List item control name                  Member name extracted
                        'LoadPicture            "Members of '<globals>' LoadPicture"    LoadPicture
                        'SavePicture            "Members of '<globals>' SavePicture"    SavePicture
                        '
                        'Bold                   "Members of 'IFontDisp' Bold"           Bold
                        'Charset                "Members of 'IFontDisp' Charset"        Charset
    
                        'Put Library name in column A and Class name in column D
                        
                        destSheet.Cells(r, "A").Value = librariesListItem.CurrentName
                        destSheet.Cells(r, "D").Value = Split(classItem.CurrentName, "Classes ")(1)
                        
                        'Determine Type of Class and put the Type in column E
                                           
                        If InStr(classLine1, "Class") = 1 Or InStr(classLine1, "Public Class") = 1 Then
                            destSheet.Cells(r, "E").Value = "Class"
                        ElseIf InStr(classLine1, "Type") = 1 Or InStr(classLine1, "Public Type") = 1 Then
                            destSheet.Cells(r, "E").Value = "Type"
                        ElseIf InStr(classLine1, "Enum") = 1 Or InStr(classLine1, "Public Enum") = 1 Then
                            destSheet.Cells(r, "E").Value = "Enum"
                        ElseIf InStr(classLine1, "Module") = 1 Then
                            destSheet.Cells(r, "E").Value = "Module"
                        End If
                    
                        'Find, but don't extract, the "Member of " or "Default member of " line, if present
                        
                        For i = 1 To UBound(classLines) - 1
                            'Debug.Print i, classLines(i)
                            If InStr(classLines(i), "Member of ") Then
                                i = i + 1
                                Exit For
                            ElseIf InStr(classLines(i), "Default member of ") Then
                                Debug.Print classLines(i)
                                Stop
                                i = i + 1
                                Exit For
                            End If
                        Next
                        
                        'Put the Class Description, if present (on last line), in column F
                        
                        If i < UBound(classLines) Then
                            destSheet.Cells(r, "F").Value = Trim(classLines(i))
                        End If
                    
                        Set membersItem = membersItemsArray.GetElement(m)
                        
                        'Put Member name in column G
                        
                        destSheet.Cells(r, "G").Value = Split(membersItem.CurrentName, "' ")(1)
                        
                        'Select this member, making the Members pane scroll to the item, if necessary
                    
                        Set memberItemSelectPattern = membersItemsArray.GetElement(m).GetCurrentPattern(UIA_SelectionItemPatternId)
                        memberItemSelectPattern.Select
                        DoEvents
            
                        'Click this member to update the Details pane
                        
                        Set memberItemPatternLegacy = membersItemsArray.GetElement(m).GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
                        memberItemPatternLegacy.DoDefaultAction
                        DoEvents
                        Sleep 10
                        
                        'Get details for this member
                        
                        With UIAuto
                            Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_DocumentControlTypeId)
                        End With
                        Set detailsDocument = panesArray.GetElement(3).FindFirst(TreeScope_Children, ControlTypeCond)
                        Set detailsDocumentTextPattern = detailsDocument.GetCurrentPattern(UIA_TextPattern2Id)
                        
                        memberLines = Split(detailsDocumentTextPattern.DocumentRange.GetText(600), vbCr)
                        memberLine1 = memberLines(0)
                                           
                        'Determine Type of Member and put the Type in columns H:I
                        
                        If InStr(memberLine1, "Sub") = 1 Or InStr(memberLine1, "Public Sub") = 1 Then
                            destSheet.Cells(r, "H").Value = "Sub"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Function") = 1 Or InStr(memberLine1, "Public Function") = 1 Then
                            destSheet.Cells(r, "H").Value = "Function"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Property") = 1 Or InStr(memberLine1, "Public Property") = 1 Then
                            destSheet.Cells(r, "H").Value = "Property"
                            destSheet.Cells(r, "I").Value = memberLine1
                            If UBound(memberLines) = 3 Then
                                'read-only line is 2nd line (memberLines(1)), put in column J
                                destSheet.Cells(r, "J").Value = "Y"
                            End If
                        ElseIf InStr(memberLine1, "Event") = 1 Or InStr(memberLine1, "Public Event") = 1 Then
                            destSheet.Cells(r, "H").Value = "Event"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Module") = 1 Then
                            destSheet.Cells(r, "H").Value = "Module"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Class") = 1 Then
                            destSheet.Cells(r, "H").Value = "Class"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Const") = 1 Or InStr(memberLine1, "Public Const") = 1 Then
                            destSheet.Cells(r, "H").Value = "Const"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Enum") = 1 Or InStr(memberLine1, "Public Enum") = 1 Then
                            destSheet.Cells(r, "H").Value = "Enum"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Type") = 1 Or InStr(memberLine1, "Public Type") = 1 Then
                            destSheet.Cells(r, "H").Value = "Type"
                            destSheet.Cells(r, "I").Value = memberLine1
                        Else
                            'Other, e.g. "cArgs As <Unsupported variant type>"
                            destSheet.Cells(r, "H").Value = "Other"
                            destSheet.Cells(r, "I").Value = memberLine1
                        End If
                                            
                        'Find and extract the "Member of " or "Default member of " line and put in columns K:L
                        
                        For i = 1 To UBound(memberLines) - 1
                            'Debug.Print i, memberLines(i)
                            If InStr(memberLines(i), "Member of ") Then
                                'Extract xxxx from "Member of xxxx" into column K
                                destSheet.Cells(r, "K").Value = Split(memberLines(i), "Member of ")(1)
                                i = i + 1
                                Exit For
                            ElseIf InStr(memberLines(i), "Default member of ") Then
                                'Extract xxxx from "Default member of xxxx" into column K and put Y flag in column L
                                destSheet.Cells(r, "K").Value = Split(memberLines(i), "Default member of ")(1)
                                destSheet.Cells(r, "L").Value = "Y"
                                i = i + 1
                                Exit For
                            End If
                        Next
                        
                        'Extract the Description, if any, into column M
                        
                        If i < UBound(memberLines) Then
                            destSheet.Cells(r, "M").Value = Trim(memberLines(i))
                        End If
                    
                        r = r + 1
                    
                    Next
                         
                Else
                    
                    'Class has no members
                    'Put Library name in column A and Class name in column D
                    
                    destSheet.Cells(r, "A").Value = librariesListItem.CurrentName
                    destSheet.Cells(r, "D").Value = Split(classItem.CurrentName, "Classes ")(1)
                    
                    'Determine Type of Class and put the Type in column E
                                       
                    If InStr(classLine1, "Class") = 1 Or InStr(classLine1, "Public Class") = 1 Then
                        destSheet.Cells(r, "E").Value = "Class"
                    ElseIf InStr(classLine1, "Type") = 1 Or InStr(classLine1, "Public Type") = 1 Then
                        destSheet.Cells(r, "E").Value = "Type"
                    ElseIf InStr(classLine1, "Enum") = 1 Or InStr(classLine1, "Public Enum") = 1 Then
                        destSheet.Cells(r, "E").Value = "Enum"
                    ElseIf InStr(classLine1, "Module") = 1 Then
                        destSheet.Cells(r, "E").Value = "Module"
                    End If
                
                    'Find, but don't extract, the "Member of " or "Default member of " line, if present
                    
                    For i = 1 To UBound(classLines) - 1
                        'Debug.Print i, classLines(i)
                        If InStr(classLines(i), "Member of ") Then
                            i = i + 1
                            Exit For
                        ElseIf InStr(classLines(i), "Default member of ") Then
                            Debug.Print classLines(i)
                            Stop
                            i = i + 1
                            Exit For
                        End If
                    Next
                    
                    'Put the Class Description, if present (on last line), in column F
                    
                    If i < UBound(classLines) Then
                        destSheet.Cells(r, "F").Value = Trim(classLines(i))
                    End If
                    
                    r = r + 1
                    
                End If
                
            Next
            
            'Click Open button again to close the Libraries combo box, ready to select the next library

            OpenPattern.DoDefaultAction
            DoEvents
            
        Else
        
            Debug.Print "Library not found: " & library
            
        End If
            
    Next
        
    'Close the Libraries combo box

    OpenPattern.DoDefaultAction
    DoEvents
        
    With destSheet
        .Range("A:A,D:D,E:E,G:G,H:H").EntireColumn.AutoFit
    End With
    
End Sub


Public Sub XAutomate_Object_Browser(OBhwnd As LongPtr, libraries As String, destSheetName As String)

    Dim UIAuto As IUIAutomation
    Dim OBwindow As IUIAutomationElement
    Dim ControlTypeAndNameCond As IUIAutomationCondition
    Dim ControlTypeCond As IUIAutomationCondition
    Dim librariesCombo As IUIAutomationElement
    Dim librariesComboExpColPattern As IUIAutomationExpandCollapsePattern
    Dim OpenButton As IUIAutomationElement
    Dim OpenPattern As IUIAutomationLegacyIAccessiblePattern
    Dim librariesList As IUIAutomationElement
    Dim librariesListArray As IUIAutomationElementArray
    Dim librariesListItem As IUIAutomationElement
    Dim libraryItemSelectPattern As IUIAutomationSelectionItemPattern
    Dim OBpane As IUIAutomationElement
    Dim panesArray As IUIAutomationElementArray
    Dim classesList As IUIAutomationElement
    Dim classesItemsArray As IUIAutomationElementArray
    Dim classItemSelectPattern As IUIAutomationSelectionItemPattern
    Dim classItemPatternLegacy As IUIAutomationLegacyIAccessiblePattern
    Dim classItem As IUIAutomationElement
    Dim membersList As IUIAutomationElement
    Dim membersItemsArray As IUIAutomationElementArray
    Dim memberItemSelectPattern As IUIAutomationSelectionItemPattern
    Dim memberItemPatternLegacy As IUIAutomationLegacyIAccessiblePattern
    Dim membersItem As IUIAutomationElement
    Dim detailsDocument As IUIAutomationElement
    Dim detailsDocumentTextPattern As IUIAutomationTextPattern
    
    Dim destSheet As Worksheet
    Dim libraryLines As Variant
    Dim library As Variant, foundLibrary As Boolean
    Dim classLines As Variant, classLine1 As String
    Dim memberLines As Variant, memberLine1 As String
    Dim i As Long, r As Long
    Dim c As Long, m As Long

    'Add destination sheet
    
    With ThisWorkbook
        On Error Resume Next
        Set destSheet = .Worksheets(destSheetName)
        On Error GoTo 0
        If destSheet Is Nothing Then
            Set destSheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            destSheet.Name = destSheetName
        End If
    End With

    'Activate Object Browser
    
    Application.SendKeys "{F2}"
    Sleep 500

    With destSheet
        .Activate
        .Cells.Delete
        .Range("A1:M1").Value = Array("Library", "File", "Reference", "Class", "Type", "Detail", "Member", "Type", "Detail", "Read only", "Member of", "Default Member", "Description")
        .Rows("1:1").RowHeight = 25
        .UsedRange.AutoFilter
    End With
        
    'Freeze row 1
    
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With

    'Get the Object Browser automation element from its window handle
    
    Set UIAuto = New CUIAutomation
    Set OBwindow = UIAuto.ElementFromHandle(ByVal OBhwnd)
    
    'Find Libraries combo box
    'Name:          "Libraries"
    'ControlType:   UIA_ComboBoxControlTypeId (0xC353)
    
    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ComboBoxControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Libraries"))
    End With
    Set librariesCombo = OBwindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)
    
    'Ensure the combo box is collapsed (closed)
    
    Set librariesComboExpColPattern = librariesCombo.GetCurrentPattern(UIA_ExpandCollapsePatternId)
    librariesComboExpColPattern.Collapse
    
    'Find the Combo box child Open button (down arrow)
    'Name:                              "Open"
    'ControlType:                       UIA_ButtonControlTypeId (0xC350)
    'LegacyIAccessible.DefaultAction:   "Open"
    
    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Open"))
    End With
    Set OpenButton = librariesCombo.FindFirst(TreeScope_Children, ControlTypeAndNameCond)
    
    'Get pattern for clicking Open button
    
    Set OpenPattern = OpenButton.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
        
    'Expand the Libraries combo box, so that list items can be found
    
    librariesComboExpColPattern.Expand
    
    'Find list in Libraries combo box
    'Name:          "Libraries"
    'ControlType:   UIA_ListControlTypeId (0xC358)

    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Libraries"))
    End With
    Set librariesList = librariesCombo.FindFirst(TreeScope_Children, ControlTypeAndNameCond)
    
    'Get array of all items in Libraries list
    'ControlType:    UIA_ListItemControlTypeId (0xC357)

    With UIAuto
        Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
    End With
    Set librariesListArray = librariesList.FindAll(TreeScope_Children, ControlTypeCond)
    
    'Debugging only - output all library items
'    Debug.Print "Libraries combobox list"
'    For i = 0 To librariesListArray.Length - 1
'        Debug.Print i; librariesListArray.GetElement(i).CurrentName
'    Next
    
    'If no libraries specified, construct list of all libraries except "<All Libraries>" from libraries combo box list
    
    If libraries = "" Then
        For i = 1 To librariesListArray.Length - 1  'start at 1 to omit the <All Libraries> item
            libraries = libraries & librariesListArray.GetElement(i).CurrentName & ","
        Next
        libraries = left(libraries, Len(libraries) - 1)
    End If
    
    'Get Object Browser pane
    'Name:          "Object Browser"
    'ControlType:   UIA_PaneControlTypeId (0xC371)

    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_PaneControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Object Browser"))
    End With
    Set OBpane = OBwindow.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)

    'Get the 4 sub-panes within the Object Browser pane: Search Results (not read by this macro); Classes; Members; Details
    'ControlType:    UIA_PaneControlTypeId (0xC371)
    
    With UIAuto
        Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_PaneControlTypeId)
    End With
    Set panesArray = OBpane.FindAll(TreeScope_Children, ControlTypeCond)
    
    'Loop through specified libraries and output members to sheet cells
    
    r = 2 'output starts at row 2 in sheet, below row 1 column headings
    
    For Each library In Split(libraries, ",")
    
        'Find this library in the Libraries combobox list
        
        foundLibrary = False
        For i = 1 To librariesListArray.Length - 1   'start at 1 to omit the <All Libraries> item
            Set librariesListItem = librariesListArray.GetElement(i)
            If librariesListItem.CurrentName = library Then
                Debug.Print "Found library: " & librariesListItem.CurrentName
                foundLibrary = True
                Exit For
            End If
        Next
        
        If foundLibrary Then
                    
            'Select this Library item, causing the Library combobox to scroll to it, if necessary
           
            Set libraryItemSelectPattern = librariesListItem.GetCurrentPattern(UIA_SelectionItemPatternId)
            libraryItemSelectPattern.Select
            DoEvents

            'Click Open button to open and expand Libraries combo box

            OpenPattern.DoDefaultAction
            DoEvents

            'Get the listbox within the Classes pane
            
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListControlTypeId)
            End With
            Set classesList = panesArray.GetElement(1).FindFirst(TreeScope_Descendants, ControlTypeCond)
            
            'Get array of items in the Classes listbox
            'ControlType:   UIA_ListItemControlTypeId (0xC357)
    
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
            End With
            Set classesItemsArray = classesList.FindAll(TreeScope_Descendants, ControlTypeCond)
            Debug.Print classesItemsArray.Length & " classes"
                
            'Get the document within the Details pane
            'Name:          "RichEdit Control"
            'ControlType:   UIA_DocumentControlTypeId (0xC36E)
            
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_DocumentControlTypeId)
            End With
            Set detailsDocument = panesArray.GetElement(3).FindFirst(TreeScope_Descendants, ControlTypeCond)
                        
            'Read Details text and write Library details to cells
            
            Set detailsDocumentTextPattern = detailsDocument.GetCurrentPattern(UIA_TextPattern2Id)
            libraryLines = Split(detailsDocumentTextPattern.DocumentRange.GetText(600), vbCr)
            destSheet.Cells(r, "A").Value = librariesListItem.CurrentName   'Library name
            destSheet.Cells(r, "B").Value = Trim(libraryLines(1))           'Library file path
            destSheet.Cells(r, "C").Value = Trim(libraryLines(2))           'Library reference
            r = r + 1
            
            'Loop through each Class in this Library
            
            For c = 0 To classesItemsArray.Length - 1
            
                Set classItem = classesItemsArray.GetElement(c)
                
                'Select this Class, causing the Classes pane to scroll to it, if necessary
            
                Set classItemSelectPattern = classItem.GetCurrentPattern(UIA_SelectionItemPatternId)
                classItemSelectPattern.Select
                DoEvents
    
                'Click this Class to make its Members appear in the Members pane
                
                Set classItemPatternLegacy = classItem.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
                classItemPatternLegacy.DoDefaultAction
                DoEvents
                Sleep 10
    
                'Extract details for this Class
                
                With UIAuto
                    Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_DocumentControlTypeId)
                End With
                Set detailsDocument = panesArray.GetElement(3).FindFirst(TreeScope_Children, ControlTypeCond)
                Set detailsDocumentTextPattern = detailsDocument.GetCurrentPattern(UIA_TextPattern2Id)
                classLines = Split(detailsDocumentTextPattern.DocumentRange.GetText(600), vbCr)
                classLine1 = classLines(0)
                
                'Get Members listbox from the Members pane
                
                With UIAuto
                    Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListControlTypeId)
                End With
                Set membersList = panesArray.GetElement(2).FindFirst(TreeScope_Descendants, ControlTypeCond)
                
                'Get all the items in the Members listbox
                
                With UIAuto
                    Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
                End With
                Set membersItemsArray = membersList.FindAll(TreeScope_Descendants, ControlTypeCond)
                
                If membersItemsArray.Length > 0 Then
                
                    'Loop through each item in the Members listbox, i.e. each Member of this Class
                    
                    For m = 0 To membersItemsArray.Length - 1
                    
                        'Note: the actual Class name as it appears in the Classes listbox is not directly available in the UIAutomation element.
                        'Instead, the Class name is contained in the control name string of the Classes listbox list item.  For Class names,
                        'the control name of each list item is always "Classes <className>" and therefore the Class name is after the word "Classes "
                        'and can be easily extracted.
                        '
                        'Similarly, the actual Member name as it appears in the Members listbox is not directly available in the UIAutomation element.
                        'Instead, the Member name is contained in the control name string of the Members listbox list item.  For Member names,
                        'the control name of each list item is always "Members of '<className>' <memberName>" and therefore the Member name is after
                        'the "' " and can be easily extracted.
                        
                        'Examples (stdole library)
                        '
                        'Classes listbox        List item control name                  Class name extracted
                        '<globals>              "Classes <globals>"                     <globals>
                        'IFontDisp              "Classes IFontDisp"                     IFontDisp
                        '
                        'Members listbox        List item control name                  Member name extracted
                        'LoadPicture            "Members of '<globals>' LoadPicture"    LoadPicture
                        'SavePicture            "Members of '<globals>' SavePicture"    SavePicture
                        '
                        'Bold                   "Members of 'IFontDisp' Bold"           Bold
                        'Charset                "Members of 'IFontDisp' Charset"        Charset
    
                        'Put Library name in column A and Class name in column D
                        
                        destSheet.Cells(r, "A").Value = librariesListItem.CurrentName
                        destSheet.Cells(r, "D").Value = Split(classItem.CurrentName, "Classes ")(1)
                        
                        'Determine Type of Class and put the Type in column E
                                           
                        If InStr(classLine1, "Class") = 1 Or InStr(classLine1, "Public Class") = 1 Then
                            destSheet.Cells(r, "E").Value = "Class"
                        ElseIf InStr(classLine1, "Type") = 1 Or InStr(classLine1, "Public Type") = 1 Then
                            destSheet.Cells(r, "E").Value = "Type"
                        ElseIf InStr(classLine1, "Enum") = 1 Or InStr(classLine1, "Public Enum") = 1 Then
                            destSheet.Cells(r, "E").Value = "Enum"
                        ElseIf InStr(classLine1, "Module") = 1 Then
                            destSheet.Cells(r, "E").Value = "Module"
                        End If
                    
                        'Find, but don't extract, the "Member of " or "Default member of " line, if present
                        
                        For i = 1 To UBound(classLines) - 1
                            'Debug.Print i, classLines(i)
                            If InStr(classLines(i), "Member of ") Then
                                i = i + 1
                                Exit For
                            ElseIf InStr(classLines(i), "Default member of ") Then
                                Debug.Print classLines(i)
                                Stop
                                i = i + 1
                                Exit For
                            End If
                        Next
                        
                        'Put the Class Description, if present (on last line), in column F
                        
                        If i < UBound(classLines) Then
                            destSheet.Cells(r, "F").Value = Trim(classLines(i))
                        End If
                    
                        Set membersItem = membersItemsArray.GetElement(m)
                        
                        'Put Member name in column G
                        
                        destSheet.Cells(r, "G").Value = Split(membersItem.CurrentName, "' ")(1)
                        
                        'Select this member, making the Members pane scroll to the item, if necessary
                    
                        Set memberItemSelectPattern = membersItemsArray.GetElement(m).GetCurrentPattern(UIA_SelectionItemPatternId)
                        memberItemSelectPattern.Select
                        DoEvents
            
                        'Click this member to update the Details pane
                        
                        Set memberItemPatternLegacy = membersItemsArray.GetElement(m).GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
                        memberItemPatternLegacy.DoDefaultAction
                        DoEvents
                        Sleep 10
                        
                        'Get details for this member
                        
                        With UIAuto
                            Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_DocumentControlTypeId)
                        End With
                        Set detailsDocument = panesArray.GetElement(3).FindFirst(TreeScope_Children, ControlTypeCond)
                        Set detailsDocumentTextPattern = detailsDocument.GetCurrentPattern(UIA_TextPattern2Id)
                        
                        memberLines = Split(detailsDocumentTextPattern.DocumentRange.GetText(600), vbCr)
                        memberLine1 = memberLines(0)
                                           
                        'Determine Type of Member and put the Type in columns H:I
                        
                        If InStr(memberLine1, "Sub") = 1 Or InStr(memberLine1, "Public Sub") = 1 Then
                            destSheet.Cells(r, "H").Value = "Sub"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Function") = 1 Or InStr(memberLine1, "Public Function") = 1 Then
                            destSheet.Cells(r, "H").Value = "Function"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Property") = 1 Or InStr(memberLine1, "Public Property") = 1 Then
                            destSheet.Cells(r, "H").Value = "Property"
                            destSheet.Cells(r, "I").Value = memberLine1
                            If UBound(memberLines) = 3 Then
                                'read-only line is 2nd line (memberLines(1)), put in column J
                                destSheet.Cells(r, "J").Value = "Y"
                            End If
                        ElseIf InStr(memberLine1, "Event") = 1 Or InStr(memberLine1, "Public Event") = 1 Then
                            destSheet.Cells(r, "H").Value = "Event"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Module") = 1 Then
                            destSheet.Cells(r, "H").Value = "Module"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Class") = 1 Then
                            destSheet.Cells(r, "H").Value = "Class"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Const") = 1 Or InStr(memberLine1, "Public Const") = 1 Then
                            destSheet.Cells(r, "H").Value = "Const"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Enum") = 1 Or InStr(memberLine1, "Public Enum") = 1 Then
                            destSheet.Cells(r, "H").Value = "Enum"
                            destSheet.Cells(r, "I").Value = memberLine1
                        ElseIf InStr(memberLine1, "Type") = 1 Or InStr(memberLine1, "Public Type") = 1 Then
                            destSheet.Cells(r, "H").Value = "Type"
                            destSheet.Cells(r, "I").Value = memberLine1
                        Else
                            'Other, e.g. "cArgs As <Unsupported variant type>"
                            destSheet.Cells(r, "H").Value = "Other"
                            destSheet.Cells(r, "I").Value = memberLine1
                        End If
                                            
                        'Find and extract the "Member of " or "Default member of " line and put in columns K:L
                        
                        For i = 1 To UBound(memberLines) - 1
                            'Debug.Print i, memberLines(i)
                            If InStr(memberLines(i), "Member of ") Then
                                'Extract xxxx from "Member of xxxx" into column K
                                destSheet.Cells(r, "K").Value = Split(memberLines(i), "Member of ")(1)
                                i = i + 1
                                Exit For
                            ElseIf InStr(memberLines(i), "Default member of ") Then
                                'Extract xxxx from "Default member of xxxx" into column K and put Y flag in column L
                                destSheet.Cells(r, "K").Value = Split(memberLines(i), "Default member of ")(1)
                                destSheet.Cells(r, "L").Value = "Y"
                                i = i + 1
                                Exit For
                            End If
                        Next
                        
                        'Extract the Description, if any, into column M
                        
                        If i < UBound(memberLines) Then
                            destSheet.Cells(r, "M").Value = Trim(memberLines(i))
                        End If
                    
                        r = r + 1
                    
                    Next
                         
                Else
                    
                    'Class has no members
                    'Put Library name in column A and Class name in column D
                    
                    destSheet.Cells(r, "A").Value = librariesListItem.CurrentName
                    destSheet.Cells(r, "D").Value = Split(classItem.CurrentName, "Classes ")(1)
                    
                    'Determine Type of Class and put the Type in column E
                                       
                    If InStr(classLine1, "Class") = 1 Or InStr(classLine1, "Public Class") = 1 Then
                        destSheet.Cells(r, "E").Value = "Class"
                    ElseIf InStr(classLine1, "Type") = 1 Or InStr(classLine1, "Public Type") = 1 Then
                        destSheet.Cells(r, "E").Value = "Type"
                    ElseIf InStr(classLine1, "Enum") = 1 Or InStr(classLine1, "Public Enum") = 1 Then
                        destSheet.Cells(r, "E").Value = "Enum"
                    ElseIf InStr(classLine1, "Module") = 1 Then
                        destSheet.Cells(r, "E").Value = "Module"
                    End If
                
                    'Find, but don't extract, the "Member of " or "Default member of " line, if present
                    
                    For i = 1 To UBound(classLines) - 1
                        'Debug.Print i, classLines(i)
                        If InStr(classLines(i), "Member of ") Then
                            i = i + 1
                            Exit For
                        ElseIf InStr(classLines(i), "Default member of ") Then
                            Debug.Print classLines(i)
                            Stop
                            i = i + 1
                            Exit For
                        End If
                    Next
                    
                    'Put the Class Description, if present (on last line), in column F
                    
                    If i < UBound(classLines) Then
                        destSheet.Cells(r, "F").Value = Trim(classLines(i))
                    End If
                    
                    r = r + 1
                    
                End If
                
            Next
            
            'Click Open button again to close the Libraries combo box, ready to select the next library

            OpenPattern.DoDefaultAction
            DoEvents
            
        Else
        
            Debug.Print "Library not found: " & library
            
        End If
            
    Next
        
    'Close the Libraries combo box

    OpenPattern.DoDefaultAction
    DoEvents
        
    With destSheet
        .Range("A:A,D:D,E:E,G:G,H:H").EntireColumn.AutoFit
    End With
    
End Sub


'THIS WORKS - CODE COPIED FROM 'LATEST' WORKBOOK
Public Sub Automate_Object_Browser2(OBhwnd As LongPtr, libraries As String, destCell As Range)

    Dim UIAuto As IUIAutomation
    Dim OB As IUIAutomationElement
    Dim ControlTypeAndNameCond As IUIAutomationCondition
    Dim ControlTypeCond As IUIAutomationCondition
    Dim librariesCombo As IUIAutomationElement
    Dim librariesComboExpColPattern As IUIAutomationExpandCollapsePattern
    Dim librariesComboExpandCollapseState As ExpandCollapseState
    Dim OpenButton As IUIAutomationElement
    Dim OpenPattern As IUIAutomationLegacyIAccessiblePattern

    Dim librariesList As IUIAutomationElement
    Dim librariesListArray As IUIAutomationElementArray
    Dim librariesListItem As IUIAutomationElement
    
    Dim InvokePattern As IUIAutomationInvokePattern
    Dim libraryItemSelectPattern As IUIAutomationSelectionItemPattern
    Dim libraryItemPatternLegacy As IUIAutomationLegacyIAccessiblePattern

    Dim OBpane As IUIAutomationElement
    Dim i As Long
    Dim r As Long
    Dim panesArray As IUIAutomationElementArray
    Dim panesItem As IUIAutomationElement
    
    Dim classesList As IUIAutomationElement
    Dim membersList As IUIAutomationElement
    
    Dim p As Long
    Dim classesItemsArray As IUIAutomationElementArray
    Dim membersItemsArray As IUIAutomationElementArray
    Dim detailsDocument As IUIAutomationElement
    
    Dim detailsDocumentTextPattern As IUIAutomationTextPattern
    Dim libraryLines As Variant
    Dim classLines As Variant, classLine1 As String
    Dim memberLines As Variant, memberLine1 As String
    Dim c As Long, m As Long
    
    Dim classItemSelectPattern As IUIAutomationSelectionItemPattern
    Dim classItemPatternLegacy As IUIAutomationLegacyIAccessiblePattern
    Dim memberItemSelectPattern As IUIAutomationSelectionItemPattern
    Dim memberItemPatternLegacy As IUIAutomationLegacyIAccessiblePattern
    
    Dim classItem As IUIAutomationElement
    
    Dim membersItem As IUIAutomationElement
    Dim detailsText As String
    Dim library As Variant
    Dim foundLibrary As Boolean

    'Get the Object Browser automation element from its window handle
    
    Set UIAuto = New CUIAutomation
    Set OB = UIAuto.ElementFromHandle(ByVal OBhwnd)
    DoEvents
    Sleep 200
    
    'Find Libraries combo box
    'Name:          "Libraries"
    'ControlType:   UIA_ComboBoxControlTypeId (0xC353)
    
    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ComboBoxControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Libraries"))
    End With
    
    Set librariesCombo = OB.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)  'found using Descendants, not Children
    
    'Find the Combo box child Open button
    'Name:                              "Open"
    'ControlType:                       UIA_ButtonControlTypeId (0xC350)
    'LegacyIAccessible.DefaultAction:   "Open"
    
    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Open"))
    End With
    
    Set librariesComboExpColPattern = librariesCombo.GetCurrentPattern(UIA_ExpandCollapsePatternId)

    'Get Libraries combo box open button (the down arrow)
    
    Set OpenButton = librariesCombo.FindFirst(TreeScope_Children, ControlTypeAndNameCond)
    If OpenButton Is Nothing Then
        librariesComboExpColPattern.Collapse
        Set OpenButton = librariesCombo.FindFirst(TreeScope_Children, ControlTypeAndNameCond)
    End If
        
    'Expand the Libraries combo box
    
    librariesComboExpColPattern.Expand
    
    'Find all items in Libraries combo box
    'Name:          "Libraries"
    'ControlType:   UIA_ListControlTypeId (0xC358)

    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Libraries"))
    End With
    Set librariesList = librariesCombo.FindFirst(TreeScope_Children, ControlTypeAndNameCond)
    
    'Get array of libraries
    'ControlType:    UIA_ListItemControlTypeId (0xC357)

    With UIAuto
        Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
    End With
    Set librariesListArray = librariesList.FindAll(TreeScope_Children, ControlTypeCond)
    
    'Debugging only - output all library items
'    Debug.Print "Libraries combobox list"
'    For i = 0 To librariesListArray.Length - 1
'        Debug.Print i; librariesListArray.GetElement(i).CurrentName
'    Next
    
    'If no libraries specified, construct a list of all the libraries except "<All Libraries>" from the libraries combo box
    
    If libraries = "" Then
        'All libraries - in combo box order
        For i = 1 To librariesListArray.Length - 1  'start at 1 to omit the <All Libraries> item
            libraries = libraries & librariesListArray.GetElement(i).CurrentName & ","
        Next
        libraries = left(libraries, Len(libraries) - 1)
    End If
    
    'Get Object Browser pane.  This contains the other panes for Search results, Classes, Members and Details
    'Name:          "Object Browser"
    'ControlType:   UIA_PaneControlTypeId (0xC371)

    With UIAuto
        Set ControlTypeAndNameCond = .CreateAndCondition(.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_PaneControlTypeId), _
                                                         .CreatePropertyCondition(UIA_NamePropertyId, "Object Browser"))
    End With
    Set OBpane = OB.FindFirst(TreeScope_Descendants, ControlTypeAndNameCond)

    'Get all the panes within the Object Browser pane
    'There are 4 panes: Search Results (not read by this macro); Classes; Members; Details
    'ControlType:    UIA_PaneControlTypeId (0xC371)
    
    With UIAuto
        Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_PaneControlTypeId)
    End With
    Set panesArray = OBpane.FindAll(TreeScope_Children, ControlTypeCond)   'children is faster than descendants
    
    'Loop through specified libraries and output to sheet cells
    
    r = 0
    
    For Each library In Split(libraries, ",")
    
        'Find this library in the Libraries combobox list
        
        foundLibrary = False
        For i = 1 To librariesListArray.Length - 1   'start at 1 to omit the <All Libraries> item
            Set librariesListItem = librariesListArray.GetElement(i)
            If librariesListItem.CurrentName = library Then
                Debug.Print "Found " & librariesListItem.CurrentName
                foundLibrary = True
                Exit For
            End If
        Next
        
        If foundLibrary Then
                    
            'Select this Library item, causing the Library combobox to scroll to it, if necessary
           
            Set libraryItemSelectPattern = librariesListItem.GetCurrentPattern(UIA_SelectionItemPatternId)
            libraryItemSelectPattern.Select
            DoEvents
            Sleep 10

            'Click Open button to open and expand Libraries combo box
            
            Set OpenPattern = OpenButton.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
            OpenPattern.DoDefaultAction
            DoEvents
            Sleep 10

            'Get the listbox within the Classes pane
            
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListControlTypeId)
            End With
            Set classesList = panesArray.GetElement(1).FindFirst(TreeScope_Descendants, ControlTypeCond)
            
            'Get array of items in the Classes listbox
            'Name:          "Classes <globals>"
            'ControlType:   UIA_ListItemControlTypeId (0xC357)
    
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
            End With
            Set classesItemsArray = classesList.FindAll(TreeScope_Descendants, ControlTypeCond)
            Debug.Print "Classes length = " & classesItemsArray.Length
            
            'Get the listbox within the Members pane
            
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListControlTypeId)
            End With
            Set membersList = panesArray.GetElement(2).FindFirst(TreeScope_Descendants, ControlTypeCond)
            
            'Get array of items in the Members listbox
            'Name:          "Members of '<globals>' ActiveCell"
            'ControlType:   UIA_ListItemControlTypeId (0xC357)
    
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
            End With
            Set membersItemsArray = membersList.FindAll(TreeScope_Descendants, ControlTypeCond)
    
            'Get the document within the Details pane
            'Name:          "RichEdit Control"
            'ControlType:   UIA_DocumentControlTypeId (0xC36E)
            
            With UIAuto
                Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_DocumentControlTypeId)
            End With
            Set detailsDocument = panesArray.GetElement(3).FindFirst(TreeScope_Descendants, ControlTypeCond)
                        
            'Read the Details pane and write library details to cells
            
            Set detailsDocumentTextPattern = detailsDocument.GetCurrentPattern(UIA_TextPattern2Id)
            libraryLines = Split(detailsDocumentTextPattern.DocumentRange.GetText(600), vbCr)
            destCell.Offset(r, 0).Value = librariesListItem.CurrentName     'Library name
            destCell.Offset(r, 1).Value = Trim(libraryLines(1))             'Library file path
            r = r + 1
            
            'Loop through each Class in this Library
            
            For c = 0 To classesItemsArray.Length - 1
            
                Set classItem = classesItemsArray.GetElement(c)
                
                'Select this Class, causing the Classes pane to scroll to it, if necessary
            
                Set classItemSelectPattern = classItem.GetCurrentPattern(UIA_SelectionItemPatternId)
                classItemSelectPattern.Select
                DoEvents
                Sleep 10
    
                'Click this Class to make its Members appear in the Members pane
                
                Set classItemPatternLegacy = classItem.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
                classItemPatternLegacy.DoDefaultAction
                DoEvents
                Sleep 10
    
                'Extract details for this Class
                
                With UIAuto
                    Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_DocumentControlTypeId)
                End With
                Set detailsDocument = panesArray.GetElement(3).FindFirst(TreeScope_Children, ControlTypeCond)
                Set detailsDocumentTextPattern = detailsDocument.GetCurrentPattern(UIA_TextPattern2Id)
                
                classLines = Split(detailsDocumentTextPattern.DocumentRange.GetText(600), vbCr)
                classLine1 = classLines(0)
                
                'Get Members listbox from the Members pane
                
                With UIAuto
                    Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListControlTypeId)
                End With
                Set membersList = panesArray.GetElement(2).FindFirst(TreeScope_Descendants, ControlTypeCond)
                
                'Get all the items in the Members listbox
                
                With UIAuto
                    Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
                End With
                Set membersItemsArray = membersList.FindAll(TreeScope_Descendants, ControlTypeCond)
            
                'Loop through each item in the Members listbox, i.e. each Member in this Class
                
                For m = 0 To membersItemsArray.Length - 1
                
                    'Put Library name and details in sheet columns
                    
                    destCell.Offset(r, 0).Value = librariesListItem.CurrentName
                    destCell.Offset(r, 2).Value = Trim(libraryLines(2)) 'Library reference
                    destCell.Offset(r, 3).Value = Split(classItem.CurrentName, "Classes ")(1)
                
                    'Determine Type of Class and put the Type in a sheet column
                                       
                    If InStr(classLine1, "Class") = 1 Or InStr(classLine1, "Public Class") = 1 Then
                        destCell.Offset(r, 4).Value = "Class"
                    ElseIf InStr(classLine1, "Type") = 1 Or InStr(classLine1, "Public Type") = 1 Then
                        destCell.Offset(r, 4).Value = "Type"
                    ElseIf InStr(classLine1, "Enum") = 1 Or InStr(classLine1, "Public Enum") = 1 Then
                        destCell.Offset(r, 4).Value = "Enum"
                    ElseIf InStr(classLine1, "Module") = 1 Then
                        destCell.Offset(r, 4).Value = "Module"
                    End If
                
                    'Find, but don't extract, the "Member of " or "Default member of " line, if present
                    
                    For i = 1 To UBound(classLines) - 1
                        'Debug.Print i, classLines(i)
                        If InStr(classLines(i), "Member of ") Then
                            i = i + 1
                            Exit For
                        ElseIf InStr(classLines(i), "Default member of ") Then
                            i = i + 1
                            Exit For
                        End If
                    Next
                    
                    'Extract the Class Description, if present
                    
                    If i < UBound(classLines) Then
                        'Description
                        destCell.Offset(r, 5).Value = Trim(classLines(i))
                    End If
                
                    Set membersItem = membersItemsArray.GetElement(m)
                    
                    'Put Member name in sheet column
                    
                    destCell.Offset(r, 6).Value = Split(membersItem.CurrentName, "' ")(1)
                    
                    'Select this member, making the Members pane scroll to the item, if necessary
                
                    Set memberItemSelectPattern = membersItemsArray.GetElement(m).GetCurrentPattern(UIA_SelectionItemPatternId)
                    memberItemSelectPattern.Select
                    DoEvents
                    Sleep 10
        
                    'Click this member to update the Details pane
                    
                    Set memberItemPatternLegacy = membersItemsArray.GetElement(m).GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
                    memberItemPatternLegacy.DoDefaultAction
                    DoEvents
                    Sleep 10
                    
                    'Get details for this member
                    
                    With UIAuto
                        Set ControlTypeCond = .CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_DocumentControlTypeId)
                    End With
                    Set detailsDocument = panesArray.GetElement(3).FindFirst(TreeScope_Children, ControlTypeCond)
                    Set detailsDocumentTextPattern = detailsDocument.GetCurrentPattern(UIA_TextPattern2Id)
                    
                    memberLines = Split(detailsDocumentTextPattern.DocumentRange.GetText(600), vbCr)
                    memberLine1 = memberLines(0)
                                       
                    'Determine Type of Member and put the Type in a sheet column
                    
                    If InStr(memberLine1, "Sub") = 1 Or InStr(memberLine1, "Public Sub") = 1 Then
                        destCell.Offset(r, 7).Value = "Sub"
                        destCell.Offset(r, 8).Value = memberLine1
                    ElseIf InStr(memberLine1, "Function") = 1 Or InStr(memberLine1, "Public Function") = 1 Then
                        destCell.Offset(r, 7).Value = "Function"
                        destCell.Offset(r, 8).Value = memberLine1
                    ElseIf InStr(memberLine1, "Property") = 1 Or InStr(memberLine1, "Public Property") = 1 Then
                         destCell.Offset(r, 7).Value = "Property"
                         destCell.Offset(r, 8).Value = memberLine1
                         If UBound(memberLines) = 3 Then
                             'read-only line is 2nd line (memberLines(1))
                             destCell.Offset(r, 9).Value = "Y"
                        End If
                    ElseIf InStr(memberLine1, "Event") = 1 Or InStr(memberLine1, "Public Event") = 1 Then
                        destCell.Offset(r, 7).Value = "Event"
                        destCell.Offset(r, 8).Value = memberLine1
                    ElseIf InStr(memberLine1, "Module") = 1 Then
                        destCell.Offset(r, 7).Value = "Module"
                        destCell.Offset(r, 8).Value = memberLine1
                    ElseIf InStr(memberLine1, "Class") = 1 Then
                        destCell.Offset(r, 7).Value = "Class"
                        destCell.Offset(r, 8).Value = memberLine1
                    ElseIf InStr(memberLine1, "Const") = 1 Or InStr(memberLine1, "Public Const") = 1 Then
                        destCell.Offset(r, 7).Value = "Const"
                        destCell.Offset(r, 8).Value = memberLine1
                    ElseIf InStr(memberLine1, "Enum") = 1 Or InStr(memberLine1, "Public Enum") = 1 Then
                        destCell.Offset(r, 7).Value = "Enum"
                        destCell.Offset(r, 8).Value = memberLine1
                    ElseIf InStr(memberLine1, "Type") = 1 Or InStr(memberLine1, "Public Type") = 1 Then
                        destCell.Offset(r, 7).Value = "Type"
                        destCell.Offset(r, 8).Value = memberLine1
                    Else
                        'Other, e.g. "cArgs As <Unsupported variant type>"
                        destCell.Offset(r, 7).Value = "Other"
                        destCell.Offset(r, 8).Value = memberLine1
                    End If
                                        
                    'Find and extract the "Member of " or "Default member of " line
                    
                    For i = 1 To UBound(memberLines) - 1
                        'Debug.Print i, memberLines(i)
                        If InStr(memberLines(i), "Member of ") Then
                            'Extract xxxx from "Member of xxxx"
                            destCell.Offset(r, 10).Value = Split(memberLines(i), "Member of ")(1)
                            i = i + 1
                            Exit For
                        ElseIf InStr(memberLines(i), "Default member of ") Then
                            'Extract xxxx from "Default member of xxxx" and put Y in Default member column
                            destCell.Offset(r, 10).Value = Split(memberLines(i), "Default member of ")(1)
                            destCell.Offset(r, 11).Value = "Y"
                            i = i + 1
                            Exit For
                        End If
                    Next
                    
                    'Extract the Description, if any
                    
                    If i < UBound(memberLines) Then
                        destCell.Offset(r, 12).Value = Trim(memberLines(i))
                    End If
                    
                    r = r + 1
                    DoEvents
               
                Next
                
            Next
            
            'Click Open button again to close the Libraries combo box, ready to select the next library

            Set OpenPattern = OpenButton.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
            OpenPattern.DoDefaultAction
            DoEvents
            Sleep 50
            
        Else
        
            Debug.Print "Library not found: " & library
            
        End If
            
    Next
        
    'Click Open button again to close the Libraries combo box
    
    Set OpenPattern = OpenButton.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
    OpenPattern.DoDefaultAction
    DoEvents
        
End Sub
 
Upvote 0
A life is not enough to learn everything ... but some try, so thank you guys for sharing.
 
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
178
John_w
J
S
  • Solved
VBA - Overpass default Scripting.Dictionary Keys comparison
Replies
4
Views
68
saboh12617
S
T
  • Question Question
VBA to update Powerpoint Text from Excel Data in Cells
Replies
9
Views
763
tbakbradley
T
A
  • Question Question
Selenium and Excel
Replies
3
Views
306
armsy
A
S
  • Question Question
Excel crashes when clicking object in the locals window od the VB Editor.
Replies
4
Views
229
Edgar_
Edgar_

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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