Using GetMem and VarPtr to get around Object defau

2019-08-02 17:54发布

This question already has an answer here:

So I'm making a funky VBA class for callback objects. Currently one of the issues is that when returning data from the function's call method I have to run the method twice, one to determine the variable type and another to return the variable:

If VarType(Application.Run(Callback("Parent") & "." & Callback("Name"), args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28), args(29))) = vbObject Then
  Set CallCallback = Application.Run( _
    Callback("Parent") & "." & Callback("Name"), _
    args(0), args(1), _
    args(2), args(3), _
    args(4), args(5), _
    args(6), args(7), _
    args(8), args(9), _
    args(10), args(11), _
    args(12), args(13), _
    args(14), args(15), _
    args(16), args(17), _
    args(18), args(19), _
    args(20), args(21), _
    args(22), args(23), _
    args(24), args(25), _
    args(26), args(27), _
    args(28), args(29))
Else
  CallCallback = Application.Run( _
    Callback("Parent") & "." & Callback("Name"), _
    args(0), args(1), _
    args(2), args(3), _
    args(4), args(5), _
    args(6), args(7), _
    args(8), args(9), _
    args(10), args(11), _
    args(12), args(13), _
    args(14), args(15), _
    args(16), args(17), _
    args(18), args(19), _
    args(20), args(21), _
    args(22), args(23), _
    args(24), args(25), _
    args(26), args(27), _
    args(28), args(29))
End If

Recently I figured that I might be able to do this without calling the VBA function multiple times by dereferencing the result using VarPtr and then using GetMem4:

Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Any) As Long
...
Dim vp As LongPtr, vRet as Variant
vp = VarPtr(Application.Run(Callback("Parent") & "." & Callback("Name"), args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28), args(29)))
Call GetMem4(vp, vRet)

This specific example didn't work but I was wondering whether there was an obvious reason as to why this didn't work?

Any ideas?

标签: excel vba
1条回答
倾城 Initia
2楼-- · 2019-08-02 18:14

I asked the question to vbforums also and they got there much faster than stackoverflow!

The solution is extremely simple:

Public Declare Sub VariantCopy Lib "oleaut32.dll" (ByRef pvargDest As Variant, ByRef pvargSrc As Variant)
...
VariantCopy CallCallback, Application.Run( _
  Callback("Parent") & "." & Callback("Name"), _
  args(0), args(1), _
  args(2), args(3), _
  args(4), args(5), _
  args(6), args(7), _
  args(8), args(9), _
  args(10), args(11), _
  args(12), args(13), _
  args(14), args(15), _
  args(16), args(17), _
  args(18), args(19), _
  args(20), args(21), _
  args(22), args(23), _
  args(24), args(25), _
  args(26), args(27), _
  args(28), args(29))

Simple!

查看更多
登录 后发表回答