Loop Through Processes

Oorang

Oorang

Well-known Member
Joined
Mar 4, 2005
Messages
2,071
I have a need to loop through every workbook open without closing them. (From Access) I was able to do that fairly easily with a for each workbook in Excel.Workbooks setup. However I realized that if there is more than one Excel Process open, I am only looping through the first Excel.Application object returned. Which means I am not truely checking everything that could be open. Which leads to the question... How do you loop through all workbooks in all Excel processes? I tried WMI but I could not figure out how to coerce a WMI Process into an Excel Application object. I'm Stumped.
 
Sort by date Sort by votes
Thank you for your answer Jaafar. For the first scenario, it's not difficult create a new AutoCAD Applicaction Instacen
Code: 
CreateObject(, "AutoCAD.Application")
Dim acadApp As AcadApplication
Set acadApp = CreateObject("AutoCAD.Application")
acadApp.Visible = True

At this moment I can create new AutoCAD Applications Instances or connect me to the first AutoCAD Application Instance opened. But I which connect me to a specific AutoCAD Application Instance opened in cas there're many of them open.

For the Tom Schreiner's code, I have problems to update it to Office 2016 with Windows 7 x64. At this point, it's no necessary have AutoCAD installed because I have problem with the lines:
Code: 
For i = ParamsCount - 1 To 0 Step -1 
    PutMem2 hGlobalOffset, asmPUSH_imm32 
    hGlobalOffset = hGlobalOffset + 1 
    GetMem4 t + i * 4, hGlobalOffset 
    hGlobalOffset = hGlobalOffset + 4 
Next

because I don't know how works the libraries
Code: 
Private Declare Function PutMem2 Lib "msvbvm60" (ByVal pWORDDst As Long, ByVal NewValue As Long) As Long 
Private Declare Function PutMem4 Lib "msvbvm60" (ByVal pDWORDDst As Long, ByVal NewValue As Long) As Long 
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal pDWORDSrc As Long, ByVal pDWORDDst As Long) As Long

for recent Office and Windows versions.

Again, if you have any advice for me related with the before code, I will remercie you !
 
Upvote 0
rvcristiand said:
Thank you for your answer Jaafar. For the first scenario, it's not difficult create a new AutoCAD Applicaction Instacen
Code: 
CreateObject(, "AutoCAD.Application")
Dim acadApp As AcadApplication
Set acadApp = CreateObject("AutoCAD.Application")
acadApp.Visible = True

At this moment I can create new AutoCAD Applications Instances or connect me to the first AutoCAD Application Instance opened. But I which connect me to a specific AutoCAD Application Instance opened in cas there're many of them open.

For the Tom Schreiner's code, I have problems to update it to Office 2016 with Windows 7 x64. At this point, it's no necessary have AutoCAD installed because I have problem with the lines:
Code: 
For i = ParamsCount - 1 To 0 Step -1 
    PutMem2 hGlobalOffset, asmPUSH_imm32 
    hGlobalOffset = hGlobalOffset + 1 
    GetMem4 t + i * 4, hGlobalOffset 
    hGlobalOffset = hGlobalOffset + 4 
Next

because I don't know how works the libraries
Code: 
Private Declare Function PutMem2 Lib "msvbvm60" (ByVal pWORDDst As Long, ByVal NewValue As Long) As Long 
Private Declare Function PutMem4 Lib "msvbvm60" (ByVal pDWORDDst As Long, ByVal NewValue As Long) As Long 
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal pDWORDSrc As Long, ByVal pDWORDDst As Long) As Long

for recent Office and Windows versions.

Again, if you have any advice for me related with the before code, I will remercie you !
Click to expand...

rvcristiand,

I have tried updating Tom's code for 64 bit but I have been unsuccesful so far... It is difficult to adapt because the PutMemX/GetMemX functions belong to the VB6/VBA6 runtime dll which is no longet available in VBA7.

Another difficulty is the fact that the CallInterface function he used uses some asm-like code that I think, relies specifically on 32bit memory layout.

Anyway, this has me intrigued and I'll keep on looking .. Maybe I'll think of taking a different approach for enumerating the ROT with vba in 64bit and if anything comes up I'll post back... In the meantime, try searching on other VB6/VBA forums.
 
Upvote 0
rvcristiand said:
For the Tom Schreiner's code, I have problems to update it to Office 2016 with Windows 7 x64. At this point, it's no necessary have AutoCAD installed because I have problem with the lines:
Code: 
For i = ParamsCount - 1 To 0 Step -1 
    PutMem2 hGlobalOffset, asmPUSH_imm32 
    hGlobalOffset = hGlobalOffset + 1 
    GetMem4 t + i * 4, hGlobalOffset 
    hGlobalOffset = hGlobalOffset + 4 
Next

because I don't know how works the libraries
Code: 
Private Declare Function PutMem2 Lib "msvbvm60" (ByVal pWORDDst As Long, ByVal NewValue As Long) As Long 
Private Declare Function PutMem4 Lib "msvbvm60" (ByVal pDWORDDst As Long, ByVal NewValue As Long) As Long 
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal pDWORDSrc As Long, ByVal pDWORDDst As Long) As Long

for recent Office and Windows versions.

Again, if you have any advice for me related with the before code, I will remercie you !
Click to expand...

Hi rvcristiand,

I think I have finally found a different solution for enumearting the Running Object Table, and hence we now have a less obscure way for retrieving all registered COM objects including all the opened workbooks in all running excel instances ... The code should now work in both, 32 and 64 bit systems .

Basically, I have looked up all the parameters and vtable offsets of all the ROT Interfaces that are involved in the code and have used the incredibly handy DispCallFunc API to query each interface and to call their respective Methods. ( No typelibs required)

Workbook example

1- Code in a Standard Module :
Code: 
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  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)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    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)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


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


Public Function AllWorkBooks() As Collection


    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim pROT As LongPtr, pRunningObjectTable As LongPtr, pEnumMoniker As LongPtr, pMoniker As LongPtr, pBindCtx As LongPtr, hRes As LongPtr, pName As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Dim pROT As Long, pRunningObjectTable As Long, pEnumMoniker As Long, pMoniker As Long, pBindCtx As Long, hRes As Long, pName As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    Dim oCol As New Collection
    Dim uGUID(0 To 3) As Long
    Dim ret As Long, nCount As Long


    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
                                    If TypeName(GetObject(GetStrFromPtrW(pName))) = "Workbook" Then
                                        oCol.Add GetObject(GetStrFromPtrW(pName))
                                    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
                        Set AllWorkBooks = oCol
                    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


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function GetStrFromPtrW(ByVal Ptr As LongPtr) As String
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function GetStrFromPtrW(ByVal Ptr As Long) As String
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    SysReAllocString VarPtr(GetStrFromPtrW), Ptr
End Function

2- Code usage example:
Code: 
Public Sub Test()
    Dim AllWbs As Collection, wb As Workbook
        
    Set AllWbs = AllWorkBooks
    If Not AllWbs Is Nothing Then
        Sheet1.Range("a1").Offset(1).Resize(Sheet1.Rows.Count - 1, 2).ClearContents
        For Each wb In AllWbs
            With Sheet1.Cells(Columns("A").Rows.Count, 1).End(xlUp)
                .Offset(1) = IIf(wb.Parent.hwnd = Application.hwnd _
                , wb.Parent.hwnd & "    [This instance]", wb.Parent.hwnd & "    [Remote instance]")
                .Offset(1, 1) = wb.FullName
            End With
            Set wb = Nothing
        Next
    End If
End Sub
 
Upvote 0
Hi Jaafar !

I tested your code and it's work very good. I will try to implemented it to get the autoCAD Applications objects. For the other hand, I want to know a few more of your code, hence I have some questions to ask. At this moment, I don't know why you do declare the next variables with this values.
Code: 
#If  VBA7 Then    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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]  
    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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]   If

It's curious because this values don't have the size of any type of variable i know.

Thank you for your help, and again your code works for me and now I will try to implemented it in my personal project.
 
Upvote 0
rvcristiand said:
Hi Jaafar !

I tested your code and it's work very good. I will try to implemented it to get the autoCAD Applications objects. For the other hand, I want to know a few more of your code, hence I have some questions to ask. At this moment, I don't know why you do declare the next variables with this values.
Code: 
#If  VBA7 Then    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
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]  
    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
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]   If

It's curious because this values don't have the size of any type of variable i know.

Thank you for your help, and again your code works for me and now I will try to implemented it in my personal project.
Click to expand...



Those constants represent the vtable offsets of the Methods of each interface.
So for example :
Code: 
Const vtbl_EnumMoniker_Next_Offset As Long = 3 * 4 * 2
refers to the the Method Next of the EnumMoniker Interface which happens to be the 3rd Method and so it resides at the memory address of 3 * 4(Bytes) .. each Method spans 4bytes = 1 Long= 32 bits .
In case of a 64 bit system, you will need to multipy by 2 ( 1 Method spans 8 bytes =2 Longs =1LongLong= 64 bits)


To adpat the code for retrieving the registered Autocads from the ROT, I suggest that you check the TypeName in the AllWorkBooks function as follows :
Code: 
On Error Resume Next
    If TypeName(GetObject(GetStrFromPtrW(pName))) = "[COLOR=#ff0000][B]Write the actual Autocad object TypeName here[/B][/COLOR]" Then
        oCol.Add GetObject(GetStrFromPtrW(pName))
    End If
On Error GoTo 0
 
Last edited:
Upvote 0
Hi Jaafar !

I'm testing your code and I found a couple of curiosities. Before to explain you, I modified your code for see what's happening. Here my modification

Code: 
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
        ActiveCell.Value = GetStrFromPtrW(pName) ' If TypeName(GetObject(GetStrFromPtrW(pName))) = nameTypeObject Then
            ' oCol.Add GetObject(GetStrFromPtrW(pName))
        ActiveCell.Offset(1, 0).Select ' End If
        ' On Error GoTo 0
        CallFunction_COM pMoniker, IUnknownRelease, vbLong, CC_STDCALL
    End If
Wend

The first one is you got the document and not the application. For example, when I run your code only with a Excel Application (and Google Chrome ^^) open I got this

Code: 
[TABLE="width: 454"]
<tbody>[TR]
[TD]D:\Google Drive\Puentes\bridge con problemas.xlsm[/TD]
[/TR]
[TR]
[TD]clsid:C01413E1-9FFB-4AB5-A942-560A8455A663:[/TD]
[/TR]
[TR]
[TD]!{00024500-0000-0000-C000-000000000046}[/TD]
[/TR]
[TR]
[TD]!{00024505-0016-0000-C000-000000000046}[/TD]
[/TR]
</tbody>[/TABLE]

And you got the object with the first value, and not with the CLSID value. Then, is possible get the application and not the document opened ?

The second one is that there are times the code not get the AutoCAD Documents opened. Then I need to close all AutoCAD Applications and open again the AutoCAD Documents. It's for this I want to get the object application and not the document opened, because I tested many times the code and I always get the CLSID of the AutoCAD Applications.

The third is you use the GetObject function. This is the VBA par default function, how is explained here https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/getobject-function, where you need to specified the document path or the object class, then you are reopen the document and not get document property.

I believe that I can solve my problem implementing the getObject used here (but it's C#) http://adndevblog.typepad.com/autoc...ml#comment-6a0167607c2431970b022ad355fe6e200c

Code: 
foreach (string clsId in clsIds)
        {
            if (displayName.ToUpper().IndexOf(clsId) > 0)
            {
                object ComObject;
                Rot.GetObject(monikers[0], out ComObject);
 
                if (ComObject == null)
                    continue;
 
                instances.Add(ComObject);
                break;
            }
        }

The problem is I don't understand so well how ROT works, but I will continued to try it !

Thank you so much for your advices.
 
Last edited:
Upvote 0
Hi,

Are you saying that you want to get the application instead of the document ? If so, then one could use the Parent or Application Properties when looping through excel workbboks .. something along theses lines :
Code: 
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
            If TypeName(GetObject(GetStrFromPtrW(pName))) = "Workbook" Then
                Dim oApp As Object
                Set oApp = GetObject(GetStrFromPtrW(pName)).Parent [B][COLOR=#008000]'<== this should give you the excel application object[/COLOR][/B]
                MsgBox oApp.Name
            End If
        On Error GoTo 0
        CallFunction_COM pMoniker, IUnknownRelease, vbLong, CC_STDCALL
    End If
Wend

Now back to AutoCad:

If Autocad documents have a Parent Property similar to that of excel workbooks then you could open an Autocad instance with a document in it , open the View>Immediate window in the VBE and try editing the code something like this :
Code: 
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
            Debug.Print GetStrFromPtrW(pName)[B][COLOR=#008000] ' <= this should give you the Autocad documents paths[/COLOR][/B]
            Debug.Print [COLOR=#333333]GetObject(GetStrFromPtrW(pName)).[/COLOR][B][COLOR=#ff0000]Parent[/COLOR][/B].Name [COLOR=#008000][B]' <= this should give you the Autocad Application name[/B][/COLOR]
[B][COLOR=#008000]            'or maybe this[/COLOR][/B]
            Debug.Print [COLOR=#333333]GetObject(GetStrFromPtrW(pName)).[/COLOR][COLOR=#ff0000][B]Parent.Parent[/B][/COLOR].Name
        On Error GoTo 0
        CallFunction_COM pMoniker, IUnknownRelease, vbLong, CC_STDCALL
    End If
Wend

Since I know nothing about AutoCad and in order for me to make sure I understand your specific scenario let me ask you this : Are the Autocad documents opened in their own seperate applications (processes) or are they embedded within excel as ActiveX controls ?

Regards.
 
Last edited:
Upvote 0
Hi Jaafar !

Thank you for your answer. Of course, I can have the parent application with
Code: 
acadDoc.Application

but I found there are times the the code
Code: 
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
        ActiveCell.Value = GetStrFromPtrW(pName) ' If TypeName(GetObject(GetStrFromPtrW(pName))) = nameTypeObject Then
            ' oCol.Add GetObject(GetStrFromPtrW(pName))
        ActiveCell.Offset(1, 0).Select ' End If
        ' On Error GoTo 0
        CallFunction_COM pMoniker, IUnknownRelease, vbLong, CC_STDCALL
    End If
Wend

don't list all the documents that are already open. I will explain it a little more. When I have many AutoCAD Applications opened before open my workbook file, I can't list the AutoCAD Documents opened. Then, I must close my AutoCAD Applications and reopen the AutoCAD Documents. For this reason, I want to know if possible get the AutoCAD Application directly, because I always get my AutoCAD Applications that are already running, doesn't matter if they are opened before or after I open my workbook. And further, when you use
Code: 
GetObject(GetStrFromPtrW(pName)).Parent
you are opening the AutoCAD document, and not get the already document opened (this is a problem if you have the document opened a you had make change).

For this, I want to know if is possible get the AutoCAD document already open, and not open it again, or get the AutoCAD Application, for iterate in each AutoCAD Document.

I see that in C# its possible towards the IRunningObjectTable's method GetObject and the IMoniker object associate of the AutoCAD Application, like it's show here http://adndevblog.typepad.com/autoc...ml#comment-6a0167607c2431970b022ad355fe6e200c
Code: 
// get Running Object Table ...
IRunningObjectTable Rot = null;
GetRunningObjectTable(0, out Rot);


if (Rot == null)
    return null;

// get enumerator for ROT entries
IEnumMoniker monikerEnumerator = null;
Rot.EnumRunning(out monikerEnumerator);

if (monikerEnumerator == null)
    return null;

monikerEnumerator.Reset();

List********> instances = new List********>();
IntPtr pNumFetched = new IntPtr();
IMoniker[] monikers = new IMoniker[1];

// go through all entries and identifies app instances
while (monikerEnumerator.Next(1, monikers, pNumFetched) == 0)
{
    IBindCtx bindCtx;
    CreateBindCtx(0, out bindCtx);
    if (bindCtx == null)
        continue;

    string displayName;

    monikers[0].GetDisplayName(bindCtx, null, out displayName);

    foreach (string clsId in clsIds)
    {
        if (displayName.ToUpper().IndexOf(clsId) > 0)
        {
            object ComObject;


            [B]Rot.GetObject(monikers[0], out ComObject)[/B];
            if (ComObject == null)
                continue;

            instances.Add(ComObject);
            break;
        }
    }
}

return instances;
but its my first time I work with external functions and I can't rewrite the IRunningObjecTable's GetObject method to works in VBA.

At this point, I found many problems for do what I want, so, if you have any advice for me, I will remercie you, or I will try other way to different to link a AutoCAD Document to Excel (for example, open a AutoCAD Document with his path, that's easier).

Thank you so much for your time and patience.
 
Last edited:
Upvote 0
rvcristiand said:
Hi Jaafar !
Click to expand...

I am afraid it is difficult for me to give you any more advice on this because I don't have autocad installed for testing plus I 've never worked with it before.

Like you said, if it is easier to open autocad documents with their paths then I would go for that.

You may also want to search the net or ask in some C, C++ forums if there is a ROT dll of some kind that you could download and use from vba to enumerate the ROT .

Good luck to you with this.
 
Last edited by a moderator:
Upvote 0
Thank you so much for your help. I will demande for implement the IRunningObjectTable's Method GetObject because it's works with the Moniker object associate to the instances and not like the VBA GetObject function, that works with the file's path or the class name (where you always get the first one you had opened).
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Compile Error User defined type not defined
Replies
7
Views
253
dmt32
D
R
  • Solved
Loop through Rows
Replies
4
Views
447
rollingzep
R
L
  • Solved
Copying user selected rows to different workbook and under matching columns
Replies
5
Views
340
LaTwiglet85
L
A
  • Solved
VBA to run through multiple files in a folder and perform an action
Replies
3
Views
396
Logit
Logit
D
  • Question Question
Filter through a table, and display the results as you type
2
Replies
10
Views
351
dpaton05
D

Share this page

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