VBAでGetName

ReadMe.mc

CallComMethodは、某天才PGのshiraさんのそのまま。

Module1.bas

Option Explicit
Private Declare Function DispCallFunc Lib "oleaut32" _
        (ByVal pvInstance As Long, ByVal oVft As Long, _
        ByVal cc As Long, ByVal vtReturn As Integer, _
        ByVal cActuals As Long, prgvt As Integer, _
        prgpvarg As Long, pvargResult As Variant) As Long
Const CC_STDCALL = 4

Sub hoge()
    Dim objEDID As stdole.IUnknown
    Dim dwDevice As Long
    Dim i As Long
    Dim s As String
    Dim hr As Long

    Set objEDID = GetObject("new:40CB6EA0-AB2A-45F8-BA45-2DC7756A7B49")
    'Set objEDID = CreateObject("igfxsrvc.EDID.1")
    
    For i = 0 To 32
        dwDevice = 1 * (2 ^ i)

        'GetName
        hr = CallComMethod(objEDID, 4, (dwDevice), StrPtr(s))
        Debug.Print Hex$(hr), dwDevice
        'S_OK
        If hr = 0 Then
              Exit For
        End If

    Next
    MsgBox s
    
End Sub

' COMのメソッド呼び出し
Private Function CallComMethod(unk As IUnknown, _
ByVal VTBLIndex As Long, ParamArray Args() As Variant) As Long

    Dim pArgs() As Long
    Dim vt() As Integer
    Dim vntResult As Variant
    Dim lngCount As Long
    Dim hr As Long
    Dim i As Long

    If unk Is Nothing Then Err.Raise 91
    lngCount = UBound(Args) + 1
    ReDim pArgs(0 To lngCount + (lngCount > 0))
    ReDim vt(0 To UBound(pArgs))
    For i = 0 To lngCount - 1
        vt(i) = VarType(Args(i))
        pArgs(i) = VarPtr(Args(i))
    Next
    hr = DispCallFunc(ObjPtr(unk), VTBLIndex * 4, _
                        CC_STDCALL, vbLong, _
                        lngCount, vt(0), pArgs(0), vntResult)
    If hr < 0 Then Err.Raise hr
    CallComMethod = vntResult

End Function