How to target instances of Excel

danacton

New Member
Joined
Dec 6, 2006
Messages
32
Hello and Merry Christmas;
Thank you ahead for any help on this... (sorry for the longwindedness)
I'm not sure how to attach my working files, but they're pretty easy to recreate.

1. At work daily I generate a report from our ERP and I export a cvs into Excel and it pops on my desktop unsaved (very simple ~ 5000 lines). I use this method because it is so much easier than having to download the full path of the network (formal computer name/users/user/folder on computer - etc.) It is also easier to teach others in my absence to do it this way (I 'think' this is a version of Excel saved on the server).
2. I also open up an attachment from my mail everyday that is attached as an excel - thus opening an entirely new instance of excel (I'm not a genius, guessing this opens with the version saved on my computer which is now office 365 I think excel 2016 - we just migrated).

Summary:

I have two open instances of Excel and filenames that change (one daily via email) and the other each time the report is generated on the ERP (the server instance of Excel).

Progress - (Sort of):
I have been able to figure out how to get these to work in a single instance of excel. (see code and attached image) with a very simple test of some data in column A.

It works! I can launch the subs from one workbook (SubcControlCenter.xls) that I have saved to my desktop - On click, it looks for a filename 'LIKE' "From" (which will always be open) and copies that data and at the end of the first sub the second sub is called which looks for a filename 'LIKE' "To" (which will always be open) to where it pastes the data in (A1). Note: In the real world the first characters of the filenames are predictable so this 'wildcard' should work.

Problem/Help:
Just a slight oversight on my part: My code only will work in a single instance of Excel. I have to figure out how to target the other instances or mainly just the "OTHER" instance. I have looked at several sites and this is way over my head with the code I have already generated versus possible solutions.
Can you help me target the instance(s) so that this code will work.

VBA Code:
Sub FindAndCopy()
  Dim wbCopy As Workbook
 
  For Each wbCopy In Workbooks
    If (wbCopy.Name) Like "From*" Then
      wbCopy.Sheets(1).Range("A:A").Copy
      Exit For
    End If
  Next wbCopy
  Call FindAndPaste
End Sub

Sub FindAndPaste()
Dim wbPaste As Workbook
    For Each wbPaste In Workbooks
    If (wbPaste.Name) Like "To*" Then
      wbPaste.Worksheets("Sheet1").Range("A1").PasteSpecial
      Exit For
    End If
  Next wbPaste
End Sub
 

Attachments

  • 3 workbooks.PNG
    3 workbooks.PNG
    145.9 KB · Views: 18

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Difficult to follow - Do you just want to execute a macro which is located in a workbook that is open in a seperate instance of excel ?
Do a search for the GetObject vba function which should enable you to get a pointer to the remote workbook.
 
Upvote 0
Hi Jaafar, yes I want to be able to execute a macro from a workbook that is saved to my desktop to an entirely different instance of excel. Thanks for the tip I will search and read about the GetObject function.
 
Upvote 0
Hello again, and Merry Christmas still. I do enjoy learning this, but get frustrated because I know virtually nothing about it.
I really don't see how I can use the GetObject Function when I only know part of the filenames (first 3 or 4 characters of each).
1 One instance opens when I export it from our legacy ERP system on the network - onto my desktop. This is the instance I am trying to access
2. Another (second) instance opens when I open the attachment I get daily in my email.

The code I posted works to find the partial filename - and I am asking if there is a way I can use the GetObject function along with this code that will find the filenname. My code only finds the filenames in a single instance.

I wouldn't begin to know how to weave this code in along with the GetObject function to access the other instance AND to find the filename. Here is the code I have again. I tried putting the GetObject function everywhere I could think of - even substituting it with the if statements below, with no luck whatsoever. Stepping through it I could see none of my ideas were even close.

VBA Code:
Sub FindAndCopy()
  Dim wbCopy As Workbook
  Dim copyObject As Object
  For Each wbCopy In Workbooks
    If (wbCopy.Name) Like "From*" Then '##use wildcards to find the filenames that are open/unsaved and change each time the report is generated/exported [B](this is the one I want to access as the object - the second instance.)[/B]
    Workbooks(wbCopy.Name).Activate
    wbCopy.Sheets(1).Range("A:A").Copy
      Exit For
    End If
  Next wbCopy
  Call FindAndPaste
End Sub

Sub FindAndPaste()
Dim wbPaste As Workbook
Dim pasteObject As Object
   For Each wbPaste In Workbooks
    If (wbPaste.Name) Like "To*" Then '##use wildcards to determine the filenames that are open/unsaved and changes each day when I open the report
    Workbooks(wbPaste.Name).Activate
      wbPaste.Worksheets("Sheet1").Range("A1").PasteSpecial
      Exit For
    End If
  Next wbPaste
End Sub
 
Upvote 0
If you only know the remote workbooks partial names then GetObject won't work and you will probably need to resort to a more complicated api based code.

Let me make sure that I understand the scenario:
"From*" workbook is open in its own seperate excel instance and "To*" workbook is also open in its own seperate instance but different from that of "From*" workbook -- Is that correct ?
Also, In which of the above instances are you running your copy-paste code ? Or are you running the code from a third different excel instance ?
In other words, How many excel instances are there before you run the code ?

EDIT:
Also, I am assuming the two workbooks "From*" and "To*" are both saved to disk ... Can you confirm that ?
 
Upvote 0
Hi Jaafar, you are correct, From instance and To instance are each running in two separate instances.

They are being being fired (executed) (or will be) from a saved file on my desktop. All the code should be written in the trigger file named 'whatever' - I've named it (SubControlCenter.xls)
So both the the instances - the "From" and the "SubControlCenter" will open on the version of Excel that is installed on my workstation in a single instance. It is only the version that I export from the ERP that opens in yet another instance. There are only (2) instances that are open at one time.

Thank you so much for your interest in helping - I am at a loss on my own.
 
Upvote 0
I just read the last line and the answer is NO - neither instance is saved to disk! The reason that I don't save them to disk is that I typically sort the file I export/open the data from the server in the servers version of excel - and then just copy it to the instance I get in the email. I don't typically save either of these files to disk. I hope that's not a deal breaker!

The reason for this project to be very simple for the user is that in my absence there are 3 or 4 people that will take over this task for me. These users are not exactly tech savvy and would struggle just to save the files somewhere where they could recall them. Quite honestly, I think that would solve my problem if they were all saved to disk as I believe they would all open in the same instance if saved locally. It is because of the tech limitations of others who have to do this task that I would like to have it as simple as it can be for them.
 
Upvote 0
I have written and tested this custom GetWorkbookLike function which is an API based alternative to the native VBA GetObject function.

This alternative function is supposed to work with Full workbook names as well as with Partial workbook names... It also accesses workbooks that are opened in seperate remote excel instances.

The function is passed part of the name of the seeked workbook but doesn't take wildcards


1- In a Standard Module:
VBA Code:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetRunningObjectTable Lib "ole32.dll" (ByVal dwReserved As Long, pROT As LongPtr) As Long
    Private Declare PtrSafe Function CreateBindCtx Lib "ole32.dll" (ByVal dwReserved As Long, pBindCtx As LongPtr) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) 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 Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As LongPtr)
    Private Declare PtrSafe Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Function GetRunningObjectTable Lib "ole32.dll" (ByVal dwReserved As Long, pROT As Long) As Long
    Private Declare Function CreateBindCtx Lib "ole32.dll" (ByVal dwReserved As Long, pBindCtx As Long) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) 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 Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
    Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

#If Win64 Then
    Private Const IUnknownRelease As Long = 2 * 4 * 2
    Private Const vtbl_EnumRunning_Offset As Long = 9 * 4 * 2
    Private Const vtbl_EnumMoniker_Next_Offset As Long = 3 * 4 * 2
    Private Const vtbl_Moniker_GetDisplayName_offset As Long = 20 * 4 * 2
#Else
    Private Const IUnknownRelease As Long = 2 * 4
    Private Const vtbl_EnumRunning_Offset As Long = 9 * 4
    Private Const vtbl_EnumMoniker_Next_Offset As Long = 3 * 4
    Private Const vtbl_Moniker_GetDisplayName_offset As Long = 20 * 4
#End If

Private Const IUnknownQueryInterface As Long = 0
Private Const CC_STDCALL As Long = 4
Private Const S_OK As Long = 0
Private Const ROT_INTERFACE_ID As String = "{00000010-0000-0000-C000-000000000046}"



Public Function GetWorkbookLike(ByVal PartOfPathName As String) As Workbook
    Set GetWorkbookLike = GetWorkbook(PartOfPathName)
    Sleep 100
End Function

Private Function GetWorkbook(ByVal PartOfPathName As String) As Workbook

    #If VBA7 Then
        Dim pROT As LongPtr, pRunningObjectTable As LongPtr, pEnumMoniker As LongPtr, pMoniker As LongPtr, pBindCtx As LongPtr, hRes As LongPtr, pName As LongPtr
   #Else
        Dim pROT As Long, pRunningObjectTable As Long, pEnumMoniker As Long, pMoniker As Long, pBindCtx As Long, hRes As Long, pName As Long
    #End If
 
    Dim uGUID(0 To 3) As Long
    Dim ret As Long, nCount As Long
    Dim oTempObj As Object

    ret = GetRunningObjectTable(0, pROT)
        If ret = S_OK Then
            ret = CreateBindCtx(0, pBindCtx)
            If ret = S_OK Then
                hRes = IIDFromString(StrPtr(ROT_INTERFACE_ID), VarPtr(uGUID(0)))
                If hRes = S_OK Then
                    If CallFunction_COM(pROT, IUnknownQueryInterface, vbLong, CC_STDCALL, VarPtr(uGUID(0)), (VarPtr(pRunningObjectTable))) = S_OK Then
                    If CallFunction_COM(pRunningObjectTable, vtbl_EnumRunning_Offset, vbLong, CC_STDCALL, (VarPtr(pEnumMoniker))) = S_OK Then
                        nCount = nCount + 1
                        While CallFunction_COM(pEnumMoniker, vtbl_EnumMoniker_Next_Offset, vbLong, CC_STDCALL, nCount, (VarPtr(pMoniker)), VarPtr(nCount)) = S_OK
                            If CallFunction_COM(pMoniker, vtbl_Moniker_GetDisplayName_offset, vbLong, CC_STDCALL, VarPtr(pBindCtx), VarPtr(pMoniker), VarPtr(pName)) = S_OK Then
                                On Error Resume Next
                                    Set oTempObj = GetObject(GetStrFromPtrW(pName))
                                    If TypeName(oTempObj) = "Workbook" Then
                                        If InStr(1, GetStrFromPtrW(pName), PartOfPathName, vbTextCompare) Then
                                            Set GetWorkbook = oTempObj
                                        End If
                                        Set oTempObj = Nothing
                                    End If
                                On Error GoTo 0
                                CallFunction_COM pMoniker, IUnknownRelease, vbLong, CC_STDCALL
                            End If
                        Wend
                        CallFunction_COM pEnumMoniker, IUnknownRelease, vbLong, CC_STDCALL
                        CallFunction_COM pBindCtx, IUnknownRelease, vbLong, CC_STDCALL
                        CallFunction_COM pRunningObjectTable, IUnknownRelease, vbLong, CC_STDCALL
                        CallFunction_COM pROT, IUnknownRelease, vbLong, CC_STDCALL
                    End If
                End If
            End If
        End If
    End If

End Function


Private Function CallFunction_COM(ByVal InterfacePointer As LongPtr, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant

    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 vParamPtr() As LongPtr, 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
        CallFunction_COM = vRtn
    Else
        SetLastError pIndex
    End If

End Function

#If VBA7 Then
    Private Function GetStrFromPtrW(ByVal Ptr As LongPtr) As String
#Else
    Private Function GetStrFromPtrW(ByVal Ptr As Long) As String
#End If
    SysReAllocString VarPtr(GetStrFromPtrW), Ptr
End Function




2- Code Usage Example:

In this example, the FindAndCopy Sub finds the workbook whose part name is "From",copies Column A:A from Sheet1 and then calls the FindAndPaste function, looks for the workbook whose part name is "To" and pastes the clipboard content onto its Sheet1 column A:A.

The code should work regardless of whether the "From" and "To" workbboks are opened in the current excel instance or in seperate instances.

VBA Code:
Sub FindAndCopy()

    Const COPY_WORKBOOK_PARTNAME As String = "From"  '<== Change partial name Const as required.
    Const PASTE_WORKBOOK_PARTNAME As String = "To"   '<== Change partial name Const as required.
    Dim oWb As Workbook
 
    Set oWb = GetWorkbookLike(COPY_WORKBOOK_PARTNAME)
    If Not oWb Is Nothing Then
        oWb.Sheets("Sheet1").Range("A:A").Copy
        If FindAndPaste(PASTE_WORKBOOK_PARTNAME) Then
            MsgBox "Copy Paste Operation Successful !"
        Else
            GoTo Failure
        End If
    Else
        GoTo Failure
    End If
 
    Exit Sub
Failure:
    MsgBox "Copy Paste Operation Failed !"

End Sub


Function FindAndPaste(ByVal PartOfName As String) As Boolean

    Dim oWb As Workbook

    Set oWb = GetWorkbookLike(PartOfName)
    If Not oWb Is Nothing Then
        oWb.Sheets("Sheet1").Select
        oWb.Sheets("Sheet1").Range("A1").Select
        oWb.Sheets("Sheet1").Paste
        FindAndPaste = True
    End If

End Function
 
Upvote 0
Please, Ignore the previous API code because it produces a compile error in excel 2007 and prior versions.... I stupidly forgot to add conditional compilation to the CallFunction_COM routine.

Here is the correct API code which should work with all OS\Office versions:
VBA Code:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetRunningObjectTable Lib "ole32.dll" (ByVal dwReserved As Long, pROT As LongPtr) As Long
    Private Declare PtrSafe Function CreateBindCtx Lib "ole32.dll" (ByVal dwReserved As Long, pBindCtx As LongPtr) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) 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 Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As LongPtr)
    Private Declare PtrSafe Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Function GetRunningObjectTable Lib "ole32.dll" (ByVal dwReserved As Long, pROT As Long) As Long
    Private Declare Function CreateBindCtx Lib "ole32.dll" (ByVal dwReserved As Long, pBindCtx As Long) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) 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 Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
    Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If


#If Win64 Then
    Private Const IUnknownRelease As Long = 2 * 4 * 2
    Private Const vtbl_EnumRunning_Offset As Long = 9 * 4 * 2
    Private Const vtbl_EnumMoniker_Next_Offset As Long = 3 * 4 * 2
    Private Const vtbl_Moniker_GetDisplayName_offset As Long = 20 * 4 * 2
#Else
    Private Const IUnknownRelease As Long = 2 * 4
    Private Const vtbl_EnumRunning_Offset As Long = 9 * 4
    Private Const vtbl_EnumMoniker_Next_Offset As Long = 3 * 4
    Private Const vtbl_Moniker_GetDisplayName_offset As Long = 20 * 4
#End If

Private Const IUnknownQueryInterface As Long = 0
Private Const CC_STDCALL As Long = 4
Private Const S_OK As Long = 0
Private Const ROT_INTERFACE_ID As String = "{00000010-0000-0000-C000-000000000046}"



Public Function GetWorkbookLike(ByVal PartOfPathName As String) As Workbook
    Set GetWorkbookLike = GetWorkbook(PartOfPathName)
    Sleep 100
End Function

Private Function GetWorkbook(ByVal PartOfPathName As String) As Workbook

    #If VBA7 Then
        Dim pROT As LongPtr, pRunningObjectTable As LongPtr, pEnumMoniker As LongPtr, pMoniker As LongPtr, pBindCtx As LongPtr, hRes As LongPtr, pName As LongPtr
    #Else
        Dim pROT As Long, pRunningObjectTable As Long, pEnumMoniker As Long, pMoniker As Long, pBindCtx As Long, hRes As Long, pName As Long
    #End If
  
    Dim uGUID(0 To 3) As Long
    Dim ret As Long, nCount As Long
    Dim oTempObj As Object

    ret = GetRunningObjectTable(0, pROT)
        If ret = S_OK Then
            ret = CreateBindCtx(0, pBindCtx)
            If ret = S_OK Then
                hRes = IIDFromString(StrPtr(ROT_INTERFACE_ID), VarPtr(uGUID(0)))
                If hRes = S_OK Then
                    If CallFunction_COM(pROT, IUnknownQueryInterface, vbLong, CC_STDCALL, VarPtr(uGUID(0)), (VarPtr(pRunningObjectTable))) = S_OK Then
                    If CallFunction_COM(pRunningObjectTable, vtbl_EnumRunning_Offset, vbLong, CC_STDCALL, (VarPtr(pEnumMoniker))) = S_OK Then
                        nCount = nCount + 1
                        While CallFunction_COM(pEnumMoniker, vtbl_EnumMoniker_Next_Offset, vbLong, CC_STDCALL, nCount, (VarPtr(pMoniker)), VarPtr(nCount)) = S_OK
                            If CallFunction_COM(pMoniker, vtbl_Moniker_GetDisplayName_offset, vbLong, CC_STDCALL, VarPtr(pBindCtx), VarPtr(pMoniker), VarPtr(pName)) = S_OK Then
                                On Error Resume Next
                                    Set oTempObj = GetObject(GetStrFromPtrW(pName))
                                    If TypeName(oTempObj) = "Workbook" Then
                                        If InStr(1, GetStrFromPtrW(pName), PartOfPathName, vbTextCompare) Then
                                            Set GetWorkbook = oTempObj
                                        End If
                                        Set oTempObj = Nothing
                                    End If
                                On Error GoTo 0
                                CallFunction_COM pMoniker, IUnknownRelease, vbLong, CC_STDCALL
                            End If
                        Wend
                        CallFunction_COM pEnumMoniker, IUnknownRelease, vbLong, CC_STDCALL
                        CallFunction_COM pBindCtx, IUnknownRelease, vbLong, CC_STDCALL
                        CallFunction_COM pRunningObjectTable, IUnknownRelease, vbLong, CC_STDCALL
                        CallFunction_COM pROT, IUnknownRelease, vbLong, CC_STDCALL
                    End If
                End If
            End If
        End If
    End If

End Function


#If VBA7 Then
    Private Function CallFunction_COM(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
#Else
    Private Function CallFunction_COM(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
        CallFunction_COM = vRtn
    Else
        SetLastError pIndex
    End If

End Function


#If VBA7 Then
    Private Function GetStrFromPtrW(ByVal Ptr As LongPtr) As String
#Else
    Private Function GetStrFromPtrW(ByVal Ptr As Long) As String
#End If
    SysReAllocString VarPtr(GetStrFromPtrW), Ptr
End Function


The previous code usage example stays the same.
 
Upvote 0
Wow! Jaafar. I have not had time to look at this carefully much less try to make it work for me, but look forward to it and:
Thank you very much for help on this!
I'll be sure to reply with any successes/failures (blamed solely on my own ineptness.)
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,185
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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