How to target instances of Excel

[danacton]

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.

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

 

[danacton]

Hi Jaafar, I am trying to insert this code as follows into my test file (workbook named: SubcControlCenter.xls)

(1). First I created 2 modules (1 and 2). I inserted the API code into module 1. Inserted the
Sub FindAndCopy() into module 2. When that didn't work, I inserted all of the code into module 1 with no change in behavior. It crashed on me. I stepped through the subs and got no errors there - (I really don't know what to look for in this advanced coding).

(2). I tried opening up 2 instances of Excel (2007 on my personal computer at home here) and windows 10.
The SubControlCenter.xls and the "To"...xls are in one instance and the "From"....xls are in another instance.
As i execute the macro the file crashes after the message in the title bar states that Excel is not responding.
Note: I get no errors or no messages from vba.

(3). I then tried opening all (3) files: (SubcControlCenter.xls), (ToINFOXTB.xls), (FromTMP5XP005.xls) each in their own instances - and I got the same same error from Excel (Microsoft Excel is not responding) and then it crashes and quickly recovers the file.

(4). Since my 'test files' are saved to disk (certainly the 'real world' ones are not) I thought maybe this was the problem. So I created 2 new workbooks in two different instances (so I now have 3 instances, book1.xls, book2.xls, and (SubcControlCenter.xls)). All of the code is in the one file which will be saved to my desktop as it is. I changed the constant variables to the following and put my data in column (A) of "Book1.xls". It still crashed on me.

Sub FindAndCopy()

    Const COPY_WORKBOOK_PARTNAME As String = "Book1"  '<== Change partial name Const as required.
    Const PASTE_WORKBOOK_PARTNAME As String = "Book2"   '<== 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

I will gladly email you my files if you want to see perhaps where I went wrong. I don't see anywhere to upload them on this forum. Again, they are very simple files just for testing - the real ones will be much more complicated. I have most of that figured out already.

Any ideas - and many Thanks so far.

 

[Jaafar Tribak]

Hi danacton,

Are you using the revised code in post#9 ?
Are you using Windows 32bit or 64bit ?
Are you mixing the code with any other code ?

Try stepping through the code line by line until you locate where it crashes... Or (for debuging purposes) add a MsgBox where you suspect the issue is and keep moving the Msgbox down until you find culprit.

I tested the code in excel 2007 and I haven't experienced any issues.

 

[danacton]

64 bit

Thanks again so much. I will keep you posted,

Hi danacton,

Are you using the revised code in post#9 ?
Are you using Windows 32bit or 64bit ?
Are you mixing the code with any other code ?

Try stepping through the code line by line until you locate where it crashes... Or (for debuging purposes) add a MsgBox where you suspect the issue is and keep moving the Msgbox down until you find culprit.

I tested the code in excel 2007 and I haven't experienced any issues.

 

[danacton]

Hi Jaafar,

I thought that maybe the problem was my machine - it's running 64 bit Excel 2007, but apparently not. I checked to see if I had any extraneous code in any of the three files - and I do not. I then mailed all 3 files to my work computer and tried the project again there on Office 365. I got the same results at first. Correct me if I'm wrong, but it appears to me that in Excel 365, all worksheets of Excel are opening up in their own instances. If I look in processes I have created what they're calling worksheets, but there is 3 different processes. In fact, I do not see how to open multiple books or files in one instance in 365.

Update:
I created all new test files (the real simple ones) on my work computer from Excel 365 and had some success. I will describe again my goal. I wish to have all the code in a saved file on my desktop that executes everything. This file is named "SubcCentralControl"

I created 2 excel files and gave them the 'Real World' names which will be: "IB862" <=== this was the 'Paste TO File' AND I created another new file in named: "~TM" <=== this was the 'Copy From File'.

Results:
I was getting mixed results. These files were saved to my disk for the convenience of testing... I was getting mixed results depending on which file I gave focus to. That is, if the "SubcCentralControl" file was active, the file was being pasted into this file. To fix this I put in the actual 'Real World' file 'partial names' and it worked sometimes, but again, depending on what instance had focus.
Solid Results:
When I changed the Constants to the 'real world' names and added this code ( oWb.Activate) - I got solid results with the saved files.

Sub FindAndCopy()

    Const COPY_WORKBOOK_PARTNAME As String = "~TM"  '<== Change partial name Const as required.
    Const PASTE_WORKBOOK_PARTNAME As String = "IB862"   '<== Change partial name Const as required.
    Dim oWb As Workbook
    'IB862 is the real world prefix for the "To" parial name.
    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.Activate 'Inserted this and now it makes the sheet active and stops the error if another sheet is selected.
        oWb.Sheets("Sheet1").Select
        oWb.Sheets("Sheet1").Range("L:L").Select
        oWb.Sheets("Sheet1").Paste
        FindAndPaste = True
    End If

End Function

The error I was getting above was if I didn't have the proper worksheet active: "Select Method of Worksheet Failed and it's the line below the one I added: oWb.Activate. If that is bad coding, please tell me what would be better. The goal is 3 worksheets open and all the user needs to do is push a button in the SubcCentralControl File. It shouldn't matter which sheet is in focus.

Now for the bad news:

My next test I did was a 'real world' machine (where I will develop this project onward).

I created a 'real world' test:

1. I generated a real world report and exported it from our server (Excel 97-2003) which opens on my computer in Excel 2010 as file "~TM"... - the rest of the filename changes. So this is on my machine unsaved. (Note: I do not see Excel 2010 loaded on my computer - don't understand this).

2. I changed the paste to location from (A1) to (L:L)

3. I opened up the email attachement and it opens in Excel 365 as "IB682".... - the rest changes. So this is also unsaved on my machine.

4. I opened up the file from which I execute all code that IS saved on my desktop "SubcCentralControl.xls. and it opens also in Excel 365. I run the macro and get the messagebox "Copy and Paste Failed".


I stepped through the code and just cannot figure it out - I'm a shipping and receiving manager - and just play around with this in my spare time. Your code is so complicated for me. I watched a video about stepping through where you could actually see all the sub routines at work, but your code is far too advanced for me to understand YET. (LOL).

The fact is - when I step through, I don't get any errors whatsoever, not even the messagebox that the Copy and Paste Failed. Only when I run the code do I get that error.

I've added a screenshot of the three open files (only one of which will is saved on my desktop) The one saved filename is: SubcControlCenter.xls

 

[danacton]

Jaafar, it also may be worth noting that that pesky outdated version of excel that is exported onto my machine opens up with Excel 2010 (32 bit) version. See images for details - and thank you so much for your patience.

 

[Jaafar Tribak]

Hi danacton,

From what I can see, it seems that the code no longer crashes your entire application unlike what you reported in an earlier post... If that's the case then this is a big progress.

You said : "Correct me if I'm wrong, but it appears to me that in Excel 365, all worksheets of Excel are opening up in their own instances"
I am not sure about that as I have never used office365 myself. Maybe someone can tell us.

Adding oWb.activate to the code should be fine although it is gererally not required to activate or select objects to perform actions on them but in this particular Copy-Paste scenario, it is needed in case a different workbook happens to be active at the time the code is executed.

The tilde character (~) preceeding the exported "~TM..." workbook looks suspiciously like a file short path name so I have amended the API code to cater for that.

Also, I have changed the GetWorkbookLike function so that it takes in its argument part of the workbook name instead of taking part of the workbook full path name.



1- Here is an amended version of the API 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)
    Private Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) 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)
    Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) 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 PartOfWorkbookName As String) As Workbook
    Set GetWorkbookLike = GetWorkbook(PartOfWorkbookName)
    Sleep 1000
End Function


Private Function GetWorkbook(ByVal PartOfWorkbookName 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 sTempArray() As String
    Dim oTempObj As Object
    Dim lRet As Long, nCount As Long, lMatchPos1 As Long, lMatchPos2 As Long
    Dim sShortPathName As String, sPath As String * 256
        
    lRet = GetRunningObjectTable(0, pROT)
        If lRet = S_OK Then
            lRet = CreateBindCtx(0, pBindCtx)
            If lRet = 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
                                        lRet = GetShortPathName(GetStrFromPtrW(pName), sPath, 256)
                                        sShortPathName = Left(sPath, lRet)
                                        sTempArray = Split(sShortPathName, "\")
                                        lMatchPos1 = InStr(1, sTempArray(UBound(sTempArray)), PartOfWorkbookName, vbTextCompare)
                                        Erase sTempArray
                                        sTempArray = Split(GetStrFromPtrW(pName), "\")
                                        lMatchPos2 = InStr(1, sTempArray(UBound(sTempArray)), PartOfWorkbookName, vbTextCompare)
                                        If lMatchPos1 Or lMatchPos2 Then
                                            Set GetWorkbook = oTempObj
                                            CallFunction_COM pMoniker, IUnknownRelease, vbLong, CC_STDCALL
                                            GoTo XitWhileWend
                                        End If
                                    End If
                                    Set oTempObj = Nothing
                                On Error GoTo 0
                                CallFunction_COM pMoniker, IUnknownRelease, vbLong, CC_STDCALL
                            End If
                        Wend
XitWhileWend:
                        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

2- The Code Usage test :

Note: (If the following test code fails, try removing tilde character (~) that preceeds the COPY Workbook and see what happens)

Sub FindAndCopy()

    Const COPY_WORKBOOK_PARTNAME As String = "~TM"   '<== Change part name Const as required.
    Const PASTE_WORKBOOK_PARTNAME As String = "IB862" '<== Change part 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.Activate
        oWb.Sheets("Sheet1").Select
        oWb.Sheets("Sheet1").Range("A1").Select
        oWb.Sheets("Sheet1").Paste
        FindAndPaste = True
    End If

End Function

 

[danacton]

Hi Jaafar,

Unfortunately I have not had much of any success while using 'unsaved' filenames.
Here are the things I've tried in order to have success with 'real world' testing files.

• I Ran the new code after replacing with your amended code. – Messagebox: Operation failed (glimmer of hope) the IB862 (the file pasting to) file does become active and moves to the foreground.
• Removed the tilde that precedes the partial filename (~TM) – copy paste failed – no other errors – result (same as #1 above – messagebox and IB682 (the paste to file is given focus – active).
• Inserted the entire filename of this particular sever output 2010 workbook into the constant variable of the file downloaded from the server thinking that perhaps the code would find it. Also inserted the entire name of this file without the tilde into Constant in the code. Copy/Paste failed.
• Inserted the entire name of each of the two files that are ‘unsaved’ with no results.
• Attempted to remove the tilde from the filename without saving it. Impossible as I have no control over the server export naming convention. Additionally, I do not have that version installed on this computer – it is being served from another location. I cannot open an additional or a new instance of Excel 2010, since my machine is running Excel 365 (which I think is version 16 of Excel (it is for MS Word)).
• Saved one of the (2) unsaved files we’re working with - and attempted to run the code in that situation – no success.
• Saved the other one of the two unsaved files we’re working with and had no success – no error, just the messagebox stating the copy paste operation failed.

The only success story:

• Saved both of the unsaved files and as before to disk, the code works.

Note the reason I don’t just save both files to my desktop or copy the entire sever output file (I think this file is the culprit) is for the ease of other users.

To save that file alone users must know the formal name of their computer\Local Disk\(Formal Name of network workstation)Computer Name\Users\username\desktop.

It is far easier to try to communicate with the unsaved file that is exported into Excel 2010.

I just never thought it would be so difficult to get there and I appreciate all of this very much - thank you.

 

[Jaafar Tribak]

I suspect that the generated workbooks do not register in the Running Object Table that's why the code doesn't find them .

Can you load the server generated workbook(s) , run the following ListAllBooks routine and post here what output you get in the Immediate Window ? This should give us a snapshot of the situation.

Option Explicit

Private Type GUID
    lData1 As Long
    iData2 As Integer
    iData3 As Integer
    aBData4(0 To 7) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Sub AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, riid As GUID, ppvObject As Any)
    Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
#Else
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Sub AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As Long, ByVal dwId As Long, riid As GUID, ppvObject As Any)
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
#End If

Private Const OBJID_NATIVEOM = &HFFFFFFF0


Sub Test()
    Call ListAllBooks
End Sub


Public Sub ListAllBooks()

    #If VBA7 Then
        Dim lXLhwnd As LongPtr, lWBhwnd As LongPtr
    #Else
        Dim lXLhwnd As Long, lWBhwnd As Long
   #End If
  
    Dim IDispatch As GUID
    Dim i As Long, lPID As Long, lPrevPID As Long
    Dim owb As Object

    With IDispatch
        .lData1 = &H20400
        .iData2 = &H0
        .iData3 = &H0
        .aBData4(0) = &HC0
        .aBData4(1) = &H0
        .aBData4(2) = &H0
        .aBData4(3) = &H0
        .aBData4(4) = &H0
        .aBData4(5) = &H0
        .aBData4(6) = &H0
        .aBData4(7) = &H46
    End With

    Do
        lXLhwnd = FindWindowEx(0, lXLhwnd, "XLMAIN", vbNullString)
        If lXLhwnd = 0 Then
            Exit Do
        Else
            lWBhwnd = FindWindowEx(FindWindowEx(lXLhwnd, 0&, "XLDESK", vbNullString), 0&, "EXCEL7", vbNullString)
            If lWBhwnd Then
                Call AccessibleObjectFromWindow(lWBhwnd, OBJID_NATIVEOM, IDispatch, owb)
                    GetWindowThreadProcessId owb.Application.hwnd, lPID
                    If lPID <> lPrevPID Then
                        Debug.Print IIf(lXLhwnd <> Application.hwnd, "Remote Application PID", "Current Application PID") & " : "; lPID
                        Debug.Print "************************************"
                        Debug.Print Space(4) & "Workbooks count : "; owb.Application.Workbooks.Count
                        For i = 1 To owb.Application.Workbooks.Count
                            Debug.Print Space(4) & "Workbook(" & i & "): "; owb.Application.Workbooks(i).FullName
                        Next i
                        Debug.Print
                    End If
                    lPrevPID = lPID
            End If
        End If
    Loop
    Set owb = Nothing

End Sub

 

[danacton]

I got no results from the routine. I generated the file from the server (unsaved), opened the excel file from my email (unsaved)

Then I opened up my worksheet where I keep all the code (excel 365) (SubcControlCenter.xls). I pasted the code into a new module and ran it - I don't see any results anywhere. Maybe I'm not looking in the right place, but nothing is happening.

I included a screenshot of what I have opened. What I find interesting in task manager on the left is that only two processes are open.
1. The file I opened from my email and the 'saved file SubcControlCenter.xls
2. The server file (~TM)... is not listed.
Also interesting is why the ListAllBooks didn't pick-up the saved file (SubcControlCenter.xls) or the (IB863) - file.

 

[Jaafar Tribak]

Quote:1"- I don't see any results anywhere. Maybe I'm not looking in the right place, but nothing is happening. "
You are indeed probably not looking in the right place... You have to look for the results in the VBE Immediate Window. (From the VBE menu , select View and then Immediate Window)

Quote:2"What I find interesting in task manager on the left is that only two processes are open "
In fact, the screenshot shows one excel process only with two workbooks opened in it.