Getting the list of all Enums in TypeLibs via code (Like the Object Browser)

[Jaafar Tribak]

Hi all,

This is a similar concept to the topic of this thread. Only this time, instead of retrieving Properties and Methods of Objects, the code now retrieves the names and values of all the native ENUM constants contained in typelibs.

No extrenal libraries required. the functions in the code use plain vba code and a few window api calls.

The code offers 3 different ways for getting the entire list of Enums contained in the target library :
GetTypeLibEnumsByGUID : Pass the tlb GUID, VerMajor and VerMinor
GetTypeLibEnumsByFilePath : Pass the tlb full PathName
GetTypeLibEnumsByObject : Pass an instance of an object

Use whichever method you find easier. You should be able to apply the above functions to get the list of enums in various tlbs, olbs, exes, dlls not just the enums in the excel library.

You could easily get the tlb GUIDs using the vbe extensibitlity library or a tlb viewer such as OLEVIEW.EXE

In the case of my excel 2016 where I wrote and tested the code, the GUID for excel is : ("{00020813-0000-0000-C000-000000000046}", 1, 9)

Workbook Example:
EnumsList.xlsm

1- API code in a Standard Module:

Option Explicit

Public Type Enums
    EnumName As String
    EnumValue 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 TYPEATTR
    aGUID As GUID
    LCID As Long
    dwReserved As Long
    memidConstructor As Long
    memidDestructor As Long
    #If Win64 Then
        lpstrSchema As LongLong
    #Else
        lpstrSchema As Long
    #End If
    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 LARGE_INT
    LowPart As Long
    HighPart As Long
End Type
 
Private Type DUMMYUNIONNAME_TYPE
    oInst As Long
    #If Win64 Then
        lpvarValue As LongLong
    #Else
        lpvarValue As Long
    #End If
End Type

Private Type VARDESC
    memid As Long
    #If Win64 Then
        lpstrSchema As LongLong
        DUMMYUNIONNAME As LongLong
    #Else
        lpstrSchema As Long
        DUMMYUNIONNAME As Long
    #End If
    elemdescVar As Long
    wVarFlags As Long
    varkind As Long
End Type


#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 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 IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As Long
    Private Declare PtrSafe Function LoadTypeLib Lib "oleaut32" (ByVal szFile As LongPtr, pptlib As LongPtr) As Long
    Private Declare PtrSafe Function LoadRegTypeLib Lib "oleaut32" (ByVal rguid As LongPtr, ByVal wVerMajor As Integer, ByVal wVerMinor As Integer, ByVal LCID As Long, ByVal pptlib As LongPtr) As Long
#Else
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
    Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
    Private Declare Function LoadTypeLib Lib "oleaut32" (ByVal szFile As Long, pptlib As Long) As Long
    Private Declare Function LoadRegTypeLib Lib "oleaut32" (ByVal rguid As Long, ByVal wVerMajor As Integer, ByVal wVerMinor As Integer, ByVal LCID As Long, ByVal pptlib As Long) As Long
#End If



Public Function GetTypeLibEnumsByGUID( _
    ByVal sGUID As String, _
    ByVal VerMajor As Integer, _
    ByVal VerMinor As Integer _
) As Enums()

    #If Win64 Then
        Const PTR_SIZE As Long = 8

        Dim pDispTypeLib As LongLong
        Dim ppTypeAttr As LongLong
        Dim pVARDESC  As LongLong
        Dim pITypeInfo As LongLong
    #Else
        Const PTR_SIZE As Long = 4

        Dim pDispTypeLib As Long
        Dim ppTypeAttr As Long
        Dim pVARDESC  As Long
        Dim pITypeInfo As Long
    #End If

    Const CC_STDCALL = 4
    Const TKIND_ENUM = 0
 
    Dim tRet() As Enums
    Dim tTYPEATTR As TYPEATTR, tVARDESC As VARDESC
    Dim tDUMMYUNIONNAME As DUMMYUNIONNAME_TYPE, tLRG_INT As LARGE_INT
    Dim BstrName As String, pcNames As Long
    Dim lTypeInfoCount As Long, index As Long, i As Long, pTKind As Long
    Dim pIndex As Long, lRet As Long, j As Long
    Dim tGUID(0 To 3) As Long
 
 
    lRet = IIDFromString(StrPtr(sGUID), VarPtr(tGUID(0)))
 
    Call LoadRegTypeLib(VarPtr(tGUID(0)), VerMajor, VerMinor, 0, VarPtr(pDispTypeLib))
    If pDispTypeLib = 0 Then MsgBox "Loading The TypeLib failed.", , "Error": Exit Function
 
    lTypeInfoCount = vtblCall(pDispTypeLib, 3 * PTR_SIZE, vbLong, CC_STDCALL) 'IDispatch::GetTypeInfoCount
    If lTypeInfoCount = 0 Then MsgBox "IDispatch::GetTypeInfoCount failed.", , "Error": Exit Function
 
    For index = 0 To lTypeInfoCount - 1
 
        lRet = vtblCall(pDispTypeLib, 5 * PTR_SIZE, vbLong, CC_STDCALL, index, VarPtr(pTKind)) 'ITypeLib::GetTypeInfoType
        If lRet Then MsgBox "ITypeLib::GetTypeInfoType failed.", , "Error": Exit Function
   
        If pTKind = TKIND_ENUM Then
   
            Call vtblCall(pDispTypeLib, 4 * PTR_SIZE, vbLong, CC_STDCALL, index, VarPtr(pITypeInfo)) 'IDispatch::GetTypeInfo
            If pITypeInfo = 0 Then MsgBox "IDispatch::GetTypeInfo failed.", , "Error": Exit Function
       
            Call vtblCall(pITypeInfo, 3 * PTR_SIZE, vbLong, CC_STDCALL, VarPtr(ppTypeAttr)) 'ITypeInfo::GetTypeAttr
            If ppTypeAttr = 0 Then MsgBox "ITypeInfo::GetTypeAttr failed.", , "Error": Exit Function
       
            Call CopyMemory(ByVal VarPtr(tTYPEATTR), ByVal ppTypeAttr, LenB(tTYPEATTR))
       
            For i = 0 To tTYPEATTR.cVars - 1
       
                Call vtblCall(pITypeInfo, 6 * PTR_SIZE, vbLong, CC_STDCALL, i, VarPtr(pVARDESC)) 'ITypeInfo::GetVarDesc
                If pVARDESC = 0 Then MsgBox "ITypeInfo::GetVarDesc failed.", , "Error": Exit Function
           
                Call CopyMemory(ByVal VarPtr(tVARDESC), ByVal pVARDESC, LenB(tVARDESC))
           
                Call vtblCall(pITypeInfo, 7 * 8, vbLong, CC_STDCALL, tVARDESC.memid, VarPtr(BstrName), tTYPEATTR.cVars, VarPtr(pcNames)) 'ITypeInfo::GetNames
                If pcNames = 0 Then MsgBox "ITypeInfo::GetNames failed.", , "Error": Exit Function
           
                Call CopyMemory(tDUMMYUNIONNAME, ByVal tVARDESC.DUMMYUNIONNAME, Len(tDUMMYUNIONNAME))
           
                Call CopyMemory(ByVal tLRG_INT, tDUMMYUNIONNAME.lpvarValue, PTR_SIZE)
           
                ReDim Preserve tRet(j) As Enums
                tRet(j).EnumName = BstrName
                tRet(j).EnumValue = tLRG_INT.LowPart
                j = j + 1
           
            Next i
   
        End If
 
    Next index
 
    GetTypeLibEnumsByGUID = tRet

End Function


Public Function GetTypeLibEnumsByFilePath(ByVal FilePathName As String) As Enums()

    #If Win64 Then
        Const PTR_SIZE As Long = 8

        Dim pDispTypeLib As LongLong
        Dim ppTypeAttr As LongLong
        Dim pVARDESC  As LongLong
        Dim pITypeInfo As LongLong
    #Else
        Const PTR_SIZE As Long = 4

        Dim pDispTypeLib As Long
        Dim ppTypeAttr As Long
        Dim pVARDESC  As Long
        Dim pITypeInfo As Long
    #End If

    Const CC_STDCALL = 4
    Const TKIND_ENUM = 0

    Dim tRet() As Enums
    Dim tTYPEATTR As TYPEATTR, tVARDESC As VARDESC
    Dim tDUMMYUNIONNAME As DUMMYUNIONNAME_TYPE, tLRG_INT As LARGE_INT
    Dim BstrName As String, pcNames As Long
    Dim lTypeInfoCount As Long, index As Long, i As Long, pTKind As Long
    Dim pIndex As Long, lRet As Long, j As Long


    Call LoadTypeLib(StrPtr(FilePathName), pDispTypeLib)
    If pDispTypeLib = 0 Then MsgBox "Loading The TypeLib failed.", , "Error": Exit Function

    lTypeInfoCount = vtblCall(pDispTypeLib, 3 * PTR_SIZE, vbLong, CC_STDCALL) 'IDispatch::GetTypeInfoCount
    If lTypeInfoCount = 0 Then MsgBox "IDispatch::GetTypeInfoCount failed.", , "Error": Exit Function

    For index = 0 To lTypeInfoCount - 1

        lRet = vtblCall(pDispTypeLib, 5 * PTR_SIZE, vbLong, CC_STDCALL, index, VarPtr(pTKind)) 'ITypeLib::GetTypeInfoType
        If lRet Then MsgBox "ITypeLib::GetTypeInfoType failed.", , "Error": Exit Function

        If pTKind = TKIND_ENUM Then

            Call vtblCall(pDispTypeLib, 4 * PTR_SIZE, vbLong, CC_STDCALL, index, VarPtr(pITypeInfo)) 'IDispatch::GetTypeInfo
            If pITypeInfo = 0 Then MsgBox "IDispatch::GetTypeInfo failed.", , "Error": Exit Function

            Call vtblCall(pITypeInfo, 3 * PTR_SIZE, vbLong, CC_STDCALL, VarPtr(ppTypeAttr)) 'ITypeInfo::GetTypeAttr
            If ppTypeAttr = 0 Then MsgBox "ITypeInfo::GetTypeAttr failed.", , "Error": Exit Function

            Call CopyMemory(ByVal VarPtr(tTYPEATTR), ByVal ppTypeAttr, LenB(tTYPEATTR))

            For i = 0 To tTYPEATTR.cVars - 1

                Call vtblCall(pITypeInfo, 6 * PTR_SIZE, vbLong, CC_STDCALL, i, VarPtr(pVARDESC)) 'ITypeInfo::GetVarDesc
                If pVARDESC = 0 Then MsgBox "ITypeInfo::GetVarDesc failed.", , "Error": Exit Function

                Call CopyMemory(ByVal VarPtr(tVARDESC), ByVal pVARDESC, LenB(tVARDESC))

                Call vtblCall(pITypeInfo, 7 * 8, vbLong, CC_STDCALL, tVARDESC.memid, VarPtr(BstrName), tTYPEATTR.cVars, VarPtr(pcNames)) 'ITypeInfo::GetNames
                If pcNames = 0 Then MsgBox "ITypeInfo::GetNames failed.", , "Error": Exit Function

                Call CopyMemory(tDUMMYUNIONNAME, ByVal tVARDESC.DUMMYUNIONNAME, Len(tDUMMYUNIONNAME))

                Call CopyMemory(ByVal tLRG_INT, tDUMMYUNIONNAME.lpvarValue, PTR_SIZE)

                ReDim Preserve tRet(j) As Enums
                tRet(j).EnumName = BstrName
                tRet(j).EnumValue = tLRG_INT.LowPart
                j = j + 1

            Next i

        End If

    Next index

    GetTypeLibEnumsByFilePath = tRet

End Function


Public Function GetTypeLibEnumsByObject(ByVal oObj As Object) As Enums()

    #If Win64 Then
        Const PTR_SIZE = 8

        Dim pObj As LongLong
        Dim pTypeInfo As LongLong
        Dim ppTypeAttr As LongLong
        Dim pVARDESC  As LongLong
        Dim pITypeInfo As LongLong
        Dim pDispTypeLib As LongLong
    #Else
        Const PTR_SIZE = 4

        Dim pObj As Long
        Dim pTypeInfo As Long
        Dim ppTypeAttr As Long
        Dim pVARDESC  As Long
        Dim pITypeInfo As Long
        Dim pDispTypeLib As Long
    #End If

    Const CC_STDCALL = 4
    Const TKIND_ENUM = 0

    Dim tRet() As Enums
    Dim tTYPEATTR As TYPEATTR, tVARDESC As VARDESC
    Dim tDUMMYUNIONNAME As DUMMYUNIONNAME_TYPE, tLRG_INT As LARGE_INT
    Dim BstrName As String, pcNames As Long
    Dim lTypeInfoCount As Long, index As Long, i As Long, pTKind As Long
    Dim pIndex As Long, lRet As Long, j As Long


    pObj = ObjPtr(oObj)

    Call vtblCall(pObj, 4 * PTR_SIZE, vbLong, CC_STDCALL, 0&, 0&, VarPtr(pTypeInfo)) 'IDispatch::GetTypeInfo
    If pTypeInfo = 0 Then MsgBox "IDispatch::GetTypeInfo failed.", , "Error": Exit Function

    Call vtblCall(pTypeInfo, 18 * PTR_SIZE, vbEmpty, CC_STDCALL, VarPtr(pDispTypeLib), VarPtr(pIndex)) 'ITypeInfo::GetContainingTypeLib
    If pDispTypeLib = 0 Then MsgBox "ITypeInfo::GetContainingTypeLib failed.", , "Error": Exit Function

    lTypeInfoCount = vtblCall(pDispTypeLib, 3 * PTR_SIZE, vbLong, CC_STDCALL) 'IDispatch::GetTypeInfoCount
    If lTypeInfoCount = 0 Then MsgBox "IDispatch::GetTypeInfoCount failed.", , "Error": Exit Function

    For index = 0 To lTypeInfoCount - 1

        lRet = vtblCall(pDispTypeLib, 5 * PTR_SIZE, vbLong, CC_STDCALL, index, VarPtr(pTKind)) 'ITypeLib::GetTypeInfoType
        If lRet Then MsgBox "ITypeLib::GetTypeInfoType failed.", , "Error": Exit Function

        If pTKind = TKIND_ENUM Then

            Call vtblCall(pDispTypeLib, 4 * PTR_SIZE, vbLong, CC_STDCALL, index, VarPtr(pITypeInfo)) 'IDispatch::GetTypeInfo
            If pITypeInfo = 0 Then MsgBox "IDispatch::GetTypeInfo failed.", , "Error": Exit Function

            Call vtblCall(pITypeInfo, 3 * PTR_SIZE, vbLong, CC_STDCALL, VarPtr(ppTypeAttr)) 'ITypeInfo::GetTypeAttr
            If ppTypeAttr = 0 Then MsgBox "ITypeInfo::GetTypeAttr failed.", , "Error": Exit Function

            Call CopyMemory(ByVal VarPtr(tTYPEATTR), ByVal ppTypeAttr, LenB(tTYPEATTR))

            Call vtblCall(pTypeInfo, 19 * PTR_SIZE, vbEmpty, CC_STDCALL, ppTypeAttr) 'ITypeInfo::ReleaseTypeAttr
       
            For i = 0 To tTYPEATTR.cVars - 1

                Call vtblCall(pITypeInfo, 6 * PTR_SIZE, vbLong, CC_STDCALL, i, VarPtr(pVARDESC)) 'ITypeInfo::GetVarDesc
                If pVARDESC = 0 Then MsgBox "ITypeInfo::GetVarDesc failed.", , "Error": Exit Function

                Call CopyMemory(ByVal VarPtr(tVARDESC), ByVal pVARDESC, LenB(tVARDESC))

                Call vtblCall(pITypeInfo, 7 * PTR_SIZE, vbLong, CC_STDCALL, tVARDESC.memid, VarPtr(BstrName), tTYPEATTR.cVars, VarPtr(pcNames)) 'ITypeInfo::GetNames
                If pcNames = 0 Then MsgBox "ITypeInfo::GetNames failed.", , "Error": Exit Function

                Call CopyMemory(tDUMMYUNIONNAME, ByVal tVARDESC.DUMMYUNIONNAME, Len(tDUMMYUNIONNAME))

                Call CopyMemory(ByVal tLRG_INT, tDUMMYUNIONNAME.lpvarValue, PTR_SIZE)

                ReDim Preserve tRet(j) As Enums
                tRet(j).EnumName = BstrName
                tRet(j).EnumValue = tLRG_INT.LowPart
                j = j + 1

            Next i

        End If

    Next index

    GetTypeLibEnumsByObject = tRet

End Function


'___________________________________________ HELPER ROUTINE _____________________________________________________

#If Win64 Then
    Private Function vtblCall( _
        ByVal InterfacePointer As LongLong, _
        ByVal VTableOffset As Long, _
        ByVal FunctionReturnType As Long, _
        ByVal CallConvention As Long, _
        ParamArray FunctionParameters() As Variant _
    ) As Variant

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

    Dim vParamPtr() As Long
#End If

    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

2- Testing (As per the workbook example in the above link)

Option Explicit


Sub Test_Lib_By_Object()

    Dim tEnums() As Enums, i As Long
 
    tEnums = GetTypeLibEnumsByObject(Excel.Application)
    With UserForm1
        .Caption = "Test_Lib_By_Object"
        .Label3 = .Label3 & UBound(tEnums) + 1
    End With
 
    With UserForm1.ListBox1
        .ColumnWidths = "150;2"
        For i = LBound(tEnums) To UBound(tEnums)
            .AddItem
            .List(i, 0) = tEnums(i).EnumName
            .List(i, 1) = tEnums(i).EnumValue '& "abcdef"
        Next i
    End With
 
    UserForm1.Show

End Sub


Sub Test_Lib_By_Path()

    Dim tEnums() As Enums, i As Long
 
    tEnums = GetTypeLibEnumsByFilePath(Application.Path & "\Excel.exe")
 
    With UserForm1
        .Caption = "LIB PATH : " & Application.Path & "\Excel.exe"
        .Label3 = .Label3 & UBound(tEnums) + 1
    End With
 
    With UserForm1.ListBox1
        .ColumnWidths = "150;2"
        For i = LBound(tEnums) To UBound(tEnums)
            .AddItem
            .List(i, 0) = tEnums(i).EnumName
            .List(i, 1) = tEnums(i).EnumValue
        Next i
    End With
 
    UserForm1.Show

End Sub


Sub Test_Lib_By_GUID()

    Dim tEnums() As Enums, i As Long
 
    'GUID may vary according to the typelib version.
    tEnums = GetTypeLibEnumsByGUID("{00020813-0000-0000-C000-000000000046}", 1, 9)
 
    With UserForm1
        .Caption = "LIB GUID : " & "{00020813-0000-0000-C000-000000000046}"
        .Label3 = .Label3 & UBound(tEnums) + 1
    End With
 
    With UserForm1.ListBox1
        .ColumnWidths = "150;2"
        For i = LBound(tEnums) To UBound(tEnums)
            .AddItem
            .List(i, 0) = tEnums(i).EnumName
            .List(i, 1) = tEnums(i).EnumValue '& "abcdef"
        Next i
    End With
 
    UserForm1.Show
End Sub

'Other Lib paths examples for testing - Paths woill need to be adjusted according to user settings.
'=================================================================================================
    '"C:\Program Files\Microsoft Office\Office16\excel.exe"
    '"C:\Program Files\Common Files\Microsoft Shared\OFFICE16\MSO.DLL"
    '"C:\Program Files\Microsoft Office\Office16\MSWORD.OLB"
    '"C:\Windows\system32\stdole32.tlb"
    '"C:\Program Files\Common Files\Microsoft Shared\VBA\VBA7.1\vbe7.dll"
    '"C:\Windows\system32\oleacc.dll"
    '"C:\Windows\system32\ieframe.dll"
    '"C:\Windows\system32\taskschd.dll"
    '"C:\Windows\system32\uiautomationcore.dll"
    '"C:\Windows\system32\wshom.ocx"
    '"c:\windows\system32\FM20.dll"

Regards.

 

[audeser]

A bit related, but not dealing specifically with Enums, given you are getting inside the DLL.

From this code Showing exported functions of a DLL in VBA (also on GitHub) Rene shows who to get the exported functions on DLLs. He seems to be using WinAPI functions only... so, is anyhow possible to get this attained on VBA instead on relaying on an external DLL? My understanding of C++ is at a very basic level (far away from that piece of c++ code, unfortunately). Please do take a look.

Should post this as new thread...

 

[audeser]

With VB6 there came the tlbInf32.dll library, but that was for x86 systems. To make it run on x64, "this" guide shows some useful information.
Related to tlbInf32, some useful links: 1, 2, 3, 4.1, 4.2. Relaying on external applications, we can go for dependencywalker, or Nirsoft's dll_export_viewer, or even using a tlb like this -shown here how to operate with it-, or this other one, but I'm not to favour any of these if I could get it done with VBA code alone.

So, finally, I think an answer could be hidden in this dense post, too hard to find on a first glance. Don't even know if any of that code could be of use on this issue. In case this option is not viable, I have an ace up my sleeve --> the "Object Browser" in the VBIDE (using Spy++ to get pointers to the panels, although it could be gathered via VBA with greater effort), and then pulling all the information out.

I'll come back as soon as I have cleared my mind on this...

 

[Jaafar Tribak]

A bit related, but not dealing specifically with Enums, given you are getting inside the DLL.

From this code Showing exported functions of a DLL in VBA (also on GitHub) Rene shows who to get the exported functions on DLLs. He seems to be using WinAPI functions only... so, is anyhow possible to get this attained on VBA instead on relaying on an external DLL? My understanding of C++ is at a very basic level (far away from that piece of c++ code, unfortunately). Please do take a look.

Me too, my understanding of C++ is quite basic.

The Enums code (subject of this thread) is a different thing as it deals with type libs NOT with PE binaries.

In order to retrieve the names of exported functions by a dll (as well as other info such as func addresses and ordinal numbers) , you will need to load an image of the PE binary and then get to the virtual addresses from the image header of the file ... Making this work in x64bit is challenging particularly when declaring the required api structures as there seems to be no such code anywhere.

Fortunately, after a day of searching and after many trial and errors, I seem to have come up with a working solution that works for both, x32 and x64 dlls:


DLLExportFunctions.xlsm


1- API code in a Standard Module:

Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
    Private Const PTR_SIZE = 8&
#Else
    Private Const NULL_PTR = 0&
    Private Const PTR_SIZE = 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 MapAndLoad Lib "Imagehlp.dll" (ByVal ImageName As String, ByVal DLLPath As String, LoadedImage As LOADED_IMAGE, ByVal DotDLL As Long, ByVal ReadOnly As Long) As Long
    Private Declare PtrSafe Function UnMapAndLoad Lib "Imagehlp.dll" (LoadedImage As LOADED_IMAGE) As Long
    Private Declare PtrSafe Function ImageRvaToVa Lib "Imagehlp.dll" (ByVal NTHeaders As LongPtr, ByVal Base As LongPtr, ByVal RVA As LongPtr, ByVal LastRvaSection As LongPtr) As LongPtr
    Private Declare PtrSafe Function lstrlenW Lib "kernel32" (ByVal lpsz As LongPtr) As Long
    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 GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
#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 MapAndLoad Lib "Imagehlp.dll" (ByVal ImageName As String, ByVal DLLPath As String, LoadedImage As LOADED_IMAGE, ByVal DotDLL As Long, ByVal ReadOnly As Long) As Long
    Private Declare Function UnMapAndLoad Lib "Imagehlp.dll" (LoadedImage As LOADED_IMAGE) As Long
    Private Declare Function ImageRvaToVa Lib "Imagehlp.dll" (ByVal NTHeaders As LongPtr, ByVal Base As LongPtr, ByVal RVA As LongPtr, ByVal LastRvaSection As LongPtr) As LongPtr
    Private Declare Function lstrlenW Lib "kernel32" (ByVal lpsz As LongPtr) As Long
    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 GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
#End If

Private Type LIST_ENTRY
  FLink As LongPtr
  Blink As LongPtr
End Type

Private Type IMAGE_EXPORT_DIRECTORY
  Characteristics         As Long
  TimeDateStamp           As Long
  MajorVersion            As Integer
  MinorVersion            As Integer
  Name                    As Long
  Base                    As Long
  NumberOfFunctions       As Long
  NumberOfNames           As Long
  AddressOfFunctions      As Long
  AddressOfNames          As Long
  AddressOfNameOrdinals   As Long
End Type

Private Const IMAGE_SIZEOF_SHORT_NAME = 8&

Private Type IMAGE_SECTION_HEADER
   ImageName(0 To IMAGE_SIZEOF_SHORT_NAME) As Byte
   Misc As Long
   VirtualAddress As Long
   SizeofRawData As Long
   PointerToRawData As Long
   PointerToRelocations As Long
   PointerToLinenumbers As Long
   NumberOfRelocations As Integer
   NumberOfLinenumbers As Integer
   Characteristics As Long
End Type

Private Type LOADED_IMAGE
  ModuleName         As LongPtr
  hFile              As LongPtr
  MappedAddress      As LongPtr
  FileHeader         As LongPtr
  LastRvaSection     As LongPtr
  NumberOfSections   As Long
  Sections           As LongPtr
  Characteristics    As Long
  fSystemImage       As Byte
  fDOSImage          As Byte
  Links              As LIST_ENTRY
  SizeOfImage        As Long
End Type

Private Type IMAGE_FILE_HEADER
   Machine               As Integer
   NumberOfSections      As Integer
   TimeDateStamp         As LongPtr
   PointerToSymbolTable  As LongPtr
   NumberOfSymbols       As Long
   SizeOfOptionalHeader  As Integer
   Characteristics       As Integer
End Type

Private Type IMAGE_DATA_DIRECTORY
    RVA  As Long
    Size As Long
End Type

Private Const IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16&

Private Type IMAGE_OPTIONAL_HEADER32
   Magic                                                 As Integer
   MajorLinkerVersion                                    As Byte
   MinorLinkerVersion                                    As Byte
   SizeOfCode                                            As Long
   SizeOfInitializedData                                 As Long
   SizeOfUninitializedData                               As Long
   AddressOfEntryPoint                                   As Long
   BaseOfCode                                            As Long
   BaseOfData                                            As Long
   ImageBase                                             As Long
   SectionAlignment                                      As Long
   FileAlignment                                         As Long
   MajorOperatingSystemVersion                           As Integer
   MinorOperatingSystemVersion                           As Integer
   MajorImageVersion                                     As Integer
   MinorImageVersion                                     As Integer
   MajorSubsystemVersion                                 As Integer
   MinorSubsystemVersion                                 As Integer
   Win32VersionValue                                     As Long
   SizeOfImage                                           As Long
   SizeOfHeaders                                         As Long
   CheckSum                                              As Long
   Subsystem                                             As Integer
   DllCharacteristics                                    As Integer
   SizeOfStackReserve                                    As Long
   SizeOfStackCommit                                     As Long
   SizeOfHeapReserve                                     As Long
   SizeOfHeapCommit                                      As Long
   LoaderFlags                                           As Long
   NumberOfRvaAndSizes                                   As Long
   DataDirectory(0 To IMAGE_NUMBEROF_DIRECTORY_ENTRIES)  As IMAGE_DATA_DIRECTORY
End Type

Private Type IMAGE_NT_HEADER  '256 bytes.
    Signature           As Long
    FileHeader          As IMAGE_FILE_HEADER
    OptionalHeader      As IMAGE_OPTIONAL_HEADER32
End Type



Public Function GetPEBinaryExports(ByVal sFile As String) As Collection

    Const IMAGE_DIRECTORY_ENTRY_EXPORT = 0&

    Dim uLoadedImage As LOADED_IMAGE
    Dim uImageHeader As IMAGE_NT_HEADER
    Dim uIEXPDIR As IMAGE_EXPORT_DIRECTORY
    Dim lRvaExportDirTable As LongPtr
    Dim lVaExportDirTable As LongPtr
    Dim ExportNamePointerTableVA As LongPtr
    Dim lNextAddr As LongPtr
    Dim lNumOfExports As Long
    Dim lRet As Long, i As Long
    Dim oExportsCollection As New Collection


    If Len(Dir(sFile)) = 0 Then
        sFile = ModuleFileName(sFile)
    End If
  
    If Len(sFile) = 0 Then
        MsgBox "File not found."
        Exit Function
    End If
  
    lRet = MapAndLoad(sFile, "", uLoadedImage, True, True)
    If lRet = 0& Then
       MsgBox "MapAndLoad failed."
       Exit Function
    End If
  
    With uLoadedImage
    Call CopyMemory(ByVal VarPtr(uImageHeader), ByVal .FileHeader, LenB(uImageHeader))
    lRvaExportDirTable = uImageHeader.OptionalHeader.DataDirectory(IMAGE_DIRECTORY_ENTRY_EXPORT).RVA
    If lRvaExportDirTable = 0& Then
       MsgBox "No export directory."
       GoTo Xit
    End If

    lVaExportDirTable = ImageRvaToVa(.FileHeader, .MappedAddress, lRvaExportDirTable, NULL_PTR)
    Call CopyMemory(ByVal VarPtr(uIEXPDIR), ByVal lVaExportDirTable, LenB(uIEXPDIR))
    lNumOfExports = uIEXPDIR.NumberOfNames

    If lNumOfExports Then
        ExportNamePointerTableVA = ImageRvaToVa(.FileHeader, .MappedAddress, uIEXPDIR.AddressOfNames, NULL_PTR)
        Call CopyMemory(lNextAddr, ByVal ExportNamePointerTableVA, PTR_SIZE)
        For i = 0& To lNumOfExports - 1&
            lNextAddr = ImageRvaToVa(.FileHeader, .MappedAddress, lNextAddr, NULL_PTR)
            oExportsCollection.Add LPSTRtoBSTR(lNextAddr)
            ExportNamePointerTableVA = ExportNamePointerTableVA + 4&
            Call CopyMemory(lNextAddr, ByVal ExportNamePointerTableVA, PTR_SIZE)
        Next
        Set GetPEBinaryExports = oExportsCollection
      Else
        MsgBox sFile & " has no export functions."
    End If
    End With

Xit:
    lRet = UnMapAndLoad(uLoadedImage)
    If lRet = 0& Then
      MsgBox "UnMapAndLoad failed."
    End If

End Function

Private Function LPSTRtoBSTR(ByVal lpString As LongPtr) As String
   Dim lStrLen As Long
   Dim lPosNullChar As Long

   lStrLen = lstrlenW(lpString)
   LPSTRtoBSTR = String$(lStrLen, 0&)
   Call CopyMemory(ByVal StrPtr(LPSTRtoBSTR), ByVal lpString, lStrLen)
   LPSTRtoBSTR = StrConv(LPSTRtoBSTR, vbUnicode)
   lPosNullChar = InStr(1&, LPSTRtoBSTR, Chr(0&), vbBinaryCompare)
   If lPosNullChar > 0& Then
      LPSTRtoBSTR = Left$(LPSTRtoBSTR, lPosNullChar - 1&)
   End If
End Function

Private Function ModuleFileName(ByVal ModuleName As String) As String
    Dim sBuffer As String, lRet As Long, hMod As LongPtr
  
    hMod = GetModuleHandle(ModuleName)
    If hMod <> GetModuleHandle("") Then
        sBuffer = Space(256)
        lRet = GetModuleFileName(hMod, sBuffer, Len(sBuffer))
        ModuleFileName = Left(sBuffer, lRet)
    End If
End Function

2- Code Usage :

Option Explicit

Sub Test()
    'Const FILE_NAME = "user32.dll"
    'Const FILE_NAME = "kernel32.dll"
    'Const FILE_NAME = "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA7.1\VBE7.DLL"
  
    Const FILE_NAME = "VBE7.dll"
    Dim oExports As New Collection, i As Long
  
    Set oExports = GetPEBinaryExports(FILE_NAME)
    With Range("A1")
        .EntireColumn.Clear
        .Font.Bold = True
        .Font.Underline = True
        .Font.Color = vbRed
        .VerticalAlignment = xlCenter
        Range("A1") = FILE_NAME & "    [ Total Exports found : " & oExports.Count & " ]"
        For i = 1 To oExports.Count
            Range("A" & i + 1) = oExports(i)
        Next
        .EntireColumn.AutoFit
    End With

End Sub

I tested on the VBE7 dll as well as on other system dlls such as user32. and kernel32 dlls and it works ok.

If I have a time, I will see if I can also retrieve the exports addresses and their ordinal numbers.