This comes up occasionally, and it's probably been done before ... but I developed it for testing some other code I've been working on. So, I thought I'd post it.
It's all fairly well outlined in the comments to the procedure, so just read those. This code can be placed anywhere, but probably best in a BAS module somewhere.
---------------------------------
Here's a test of it with a Sub Main project and a single Sub procedure:
---------------------------------
Here's another test with a Sub Main project calling a Function:
---------------------------------
Feel free to test with Property procedures or other procedures with different types of arguments. It does have some limitations, and those are listed in the comments.
It's all fairly well outlined in the comments to the procedure, so just read those. This code can be placed anywhere, but probably best in a BAS module somewhere.
Code:
Option Explicit
'
Private Declare Function DispCallFunc Lib "oleaut32" (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
'
Public Function CallBasProcedureByAddress(ByVal ProcAddress As Long, _
ByVal ReturnType As VbVarType, _
ByRef vReturn As Variant, _
ParamArray vProcArguments() As Variant) As Boolean
'
' Regarding the actual procedure's address (ProcAddress), Private or Public
' doesn't matter, so long as you can get the procedure's address.
' This is typically done with the AddressOf operator.
'
' If there's any problem that can be trapped, this function returns FALSE.
' Caller is totally responsible for passing correct arguments,
' and correctly specifying the return type for Function or Property Get (ReturnType),
' or probable crash. Read on.
'
' If it's a Function or Property Get, the return is returned in vReturn.
' Otherwise, ReturnType should be specified as vbEmpty (vbEmpty=0&).
'
' vProcArguments:
' These MUST match the procedure being called.
' Be SURE to pass the correct variable TYPE. (or crash)
' If it's ByRef, pass VarPtr(value). (or crash)
' If it's ByVal, pass it directly. (or crash)
' Not tested for String, Array, UDT, or Object arguments (including when in a Variant).
' Variant arguments may also present challenges not considered herein,
' but they should work if they don't contain an address reference (i.e., String, Array, or Object).
'
' Get arguments into a more manageable array.
Dim vParams() As Variant: vParams() = vProcArguments()
' Figure out how many actual arguments we're passing to DispCallFunc.
Dim iParamCount As Long: iParamCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
'
' Setup memory pointers and types for DispCallFunc call.
Dim vParamPtr() As Long, vParamType() As Integer
If iParamCount Then
ReDim vParamPtr(iParamCount - 1&)
ReDim vParamType(iParamCount - 1&)
Else
ReDim vParamPtr(0&)
ReDim vParamType(0&)
End If
Dim iParamIndex As Long
For iParamIndex = 0& To iParamCount - 1& ' If iParamCount = 0& then loop won't execute.
vParamPtr(iParamIndex) = VarPtr(vParams(iParamIndex))
vParamType(iParamIndex) = VarType(vParams(iParamIndex))
Next
'
' Make our DispCallFunc call. Return value takes care of itself if it was specified correctly.
Const CC_STDCALL As Long = 4&
Dim iRet As Long
' Since it's a non-Object, we specify 0 for the pvInstance, so DispCallFunc understands.
iRet = DispCallFunc(0&, ProcAddress, CC_STDCALL, ReturnType, iParamCount, vParamType(0&), vParamPtr(0&), vReturn)
If iRet = 0& Then CallBasProcedureByAddress = True
End Function
Here's a test of it with a Sub Main project and a single Sub procedure:
Code:
Private Sub Main()
Dim vRet As Variant ' Not used but needed for call.
' Notice that I'm careful that the TYPEs and Varptr (or not) are correct, or crash.
CallBasProcedureByAddress AddressOf TestSub1, vbEmpty, vRet, VarPtr(111), 222&, VarPtr(333!), 444#
End Sub
Private Sub TestSub1(ByRef arg1 As Integer, ByVal arg2 As Long, ByRef arg3 As Single, ByVal arg4 As Double)
' Notice that the arguments are a mixture of ByRef & ByVal.
' There is also a hodpodge of types.
'
Debug.Print TypeName(arg1); ":"; arg1, TypeName(arg2); ":"; arg2, TypeName(arg3); ":"; arg3, TypeName(arg4); ":"; arg4
' Prints: Integer: 111 Long: 222 Single: 333 Double: 444
End Sub
Here's another test with a Sub Main project calling a Function:
Code:
Option Explicit
Private Sub Main()
Dim vRet As Variant
Dim arg1 As Integer: arg1 = 111
CallBasProcedureByAddress AddressOf TestFn1, vbDouble, vRet, VarPtr(arg1), 222&
Debug.Print "Return: "; TypeName(vRet); ":"; vRet, "Arg1: "; TypeName(arg1); ":"; arg1
' Prints: Return: Double: 333 Arg1: Integer: 999
End Sub
Private Function TestFn1(ByRef arg1 As Integer, ByVal arg2 As Long) As Double
TestFn1 = arg1 + arg2
arg1 = 999
' We can change arg2 but change won't be returned because it's ByVal.
End Function
Feel free to test with Property procedures or other procedures with different types of arguments. It does have some limitations, and those are listed in the comments.