OLEObjects.Add Results In Multiple Instances of Excel

[B99]

I posted this on another forum but haven't gotten any results so I'm hoping I'll have better luck here. I have an Access DB that exports data to Excel, including images and documents that I insert using OLEObjects.Add. This is my first time using this function and it has been a learning process but after countless iterations, I have it 'mostly' working. The end result spreadsheet is what I want, however when there is an Excel spreadsheet that is being inserted into the target spreadsheet, the process creates (and leaves open) multiple instances of Excel - two additional instances for each inserted Excel sheet. The additional instances do not have any worksheets open but they are active, meaning I can navigate menus, etc. This does not happen for other Office documents or PDFs, only Excel files. And what's even more strange is that I am unable to close several of the instances after the process completes.

Here is the code I'm using to insert the files:

  Dim xlApp As Excel.Application    'Open the Excel application
  Dim xlBook As Excel.Workbook      'Create a new Excel workbook
  Dim xlImg As Excel.Worksheet      'Create a tab with Attachment details

  Set xlApp = Excel.Application
  Set xlBook = xlApp.Workbooks.Add

'First I add a 'data only' worksheet and do some processing on it, then add a new sheet below for the attachments

  xlBook.Worksheets.Add
  Set xlImg = xlBook.Worksheets(1)

'I get the filename from a recordset
'strIcon is the default executable for the file type
'strAtchName is the file name without the path

xlBook.ActiveSheet.OLEObjects.Add(FileName:=<recordset filename>, _
          Link:=False, DisplayAsIcon:=True, IconFileName:=strIcon, _
          Left:=ActiveSheet.Range("D" & x).Left, Width:=13, _
          Top:=ActiveSheet.Range("D" & x).Top, Height:=56, _
          iconlabel:=strAtchName).Select

'More formatting, then cleanup

Here is a screenshot where there were 6 files that were inserted into the export spreadsheet; 3 Excel files, one Word doc, one PDF and one PPT. Excel was closed before the export, and the screenshot shows 7 instances were running after the process completed.

If I try to close any of the 7, it asks me if I want to save the changes to the export spreadsheet (Book5 in this case). After saving (or discarding), 4 of the instances close and I am left with "ExcelTest2.xlsx", "Excel" and "Book1.xlsx" in this example. I am unable to close any of those without forcing it in Task Manager. However, if I open a new (unrelated) Excel file and close it, two of the instances disappear and if I repeat that process, the third one disappears.

Any ideas on what I can do to either prevent the extra instances from opening or somehow close them? I want to leave the main spreadsheet open so that the user can review it. Thanks in advance for any help!

 

[Micron]

KS = Ken Snell - as mentioned.
If you don't want to show the sheet or app, open it as .Visble = False - don't monkey with the min/max, esp. if you're going to use Active whatever.
ActiveSheet isn't unless your mouse has made it so, or you have coded to make it the active sheet. I'd never rely on circumstances to code for the "active" anything*.

If you need me or anyone else to take a look at a file at that link, it looks like you'd have to say which one. There is quite a list.

* unless the code could only run if the object was the active object

 

[Legacy 456155]

If you need me or anyone else to take a look at a file at that link, it looks like you'd have to say which one. There is quite a list.

B99.zip

It's the file B99 mentioned earlier with the edits I tried out. Anyway, I've done what I can here. Will wait and see what he comes with. Have a good one.

 

[B99]

Apologies for the delay; I'm on vacation and trying to avoid work for a few days

I downloaded and tried the version from your OneDrive but it behaved the same as before on my machine; I ended up with 5 instances of Excel at the end. The only change that I made was to remove the reference to Excel 16.0 (which I don't have) and replace with Excel 15.0. I also made the suggested changes in my full DB with the same results.

From what I noticed earlier (if I leave Excel visible the entire time and avoid the xlApp.Visible = True after processing the attachments then it works as expected), it does seem to be related to references. Is there a way to more explicitly qualify the .Visible so that it only applies to a specific workbook? I noticed it is not a method available on the workbook object. Or maybe force the attachment instances to close before the app becomes visible?

Thanks for your help! No rush as it may be a few days before I can devote more than an hour or two.

 

[Micron]

I downloaded and stepped through the code. I got 1 instance of Excel and one sub process for Excel which made it look like a 2 count (something about a print driver). When I just let it run, I only had 1 instance running, so I don't see a problem. Regardless, there was only one workbook open. Perhaps there is some difference between what your linked file does and what your pc file does.

 

[Legacy 456155]

Excel is not cleaning up after itself. Not very quickly, anyway. Running the example, I do occasionally get a rogue instance that does not close right away and can't be referenced. Apparently, the application does not register itself, but the individual workbooks do. So, if you have an instance running without an open workbook, it is not accessible to GetObject(). I did note that the process does eventually die off in a few moments. Check your command line in your task manager and see if the args are the same as these.

If so, these should die the death in a moment of two.

 

[Legacy 456155]

See this page for more options as you may need to filter your process list further. I suppose you could run this AFTER the workbook has been saved and closed.

Sub KillEmbeddedExcels()
    Dim WMI, Processes, Process
    Set WMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
      Environ("COMPUTERNAME") & "\root\cimv2")
     
    Set Processes = WMI.ExecQuery("select * from win32_process")
   
    For Each Process In Processes
        With Process
            If .Name = "EXCEL.EXE" And InStr(.CommandLine, "/automation -Embedding") Then .Terminate
        End With
    Next
End Sub

 

[Micron]

So, if you have an instance running without an open workbook, it is not accessible to GetObject()

I'm afraid I don't agree with that - at least not as a blanket statement. If Excel is running, GetObject should detect that it is open even if a workbook is not open, but maybe not if it's opened by another process. I have no way to test that since when you execute this code Excel opens as a background process and closes if the code is terminated. Therefore, GetObject probably won't detect the instance within this db since you can't run 2 such procedures at the same time. However, if you open Excel first but don't open a workbook, GetObject will detect the instance. Since GetObject isn't used in the sample db code, I'm not sure I understand why it would matter.

Since I didn't experience multiple instances, I'm not sure what else I have to contribute to this.

 

[Legacy 456155]

Since GetObject isn't used in the sample db code, I'm not sure I understand why it would matter.

I was thinking along the lines of using GetObject to fetch a reference to B99's extra instances. But those instances do not have an open workbook, so I failed to get a reference. I tested that by looking for a handle to the workbook window. It returned zero. The code below demonstrates what I was trying to explain. As far as I know, the application does not register itself in the running object table, but each workbook does. That is why, in Ex2 below, xl2 returns an identical reference. If there is a way to get a reference to an application without an open workbook, I don't know of it.

Private xl1 As Excel.Application
Private xl2 As Excel.Application

Sub Ex1()
    'run from app other than Excel with no open instances
    Set xl1 = New Excel.Application
    Debug.Print xl1.Workbooks.Count, xl1.hwnd
    
    'will not get ref to only open instance, but instead, creates a new instance
    Set xl2 = GetObject("", "Excel.Application")
    Debug.Print xl2.Workbooks.Count, xl2.hwnd
    
    xl1.Quit
    xl2.Quit
    
    Set xl1 = Nothing
    Set xl2 = Nothing
End Sub

Sub Ex2()
    'run from app other than Excel with no open instances
    Set xl1 = New Excel.Application
    xl1.Workbooks.Add
    Debug.Print xl1.Workbooks.Count, xl1.hwnd
    
    'will get a reference to the existing application
    Set xl2 = GetObject(xl1.Workbooks(1).Name).Application
    Debug.Print xl2.Workbooks.Count, xl2.hwnd
    
    xl1.Quit
    xl2.Quit
    
    Set xl1 = Nothing
    Set xl2 = Nothing
End Sub

 

[Micron]

I think I see a 'mistake'. If you provide a zls ("") for the object path argument the function returns a new instance of the specified type. If you don't provide the path argument, a new instance is created. So you would need to code as GetObject( , "Excel.Application") and not GetObject( "", "Excel.Application") [extra spaces added for clarity]

Thus that syntax will create a new application object every time it is called. However, since I didn't see that call in the sample db, I still don't know how OP ended up with multiple instances.

 

[Legacy 456155]

I think I see a 'mistake'. If you provide a zls ("") for the object path argument the function returns a new instance of the specified type

Yeah, apparently. I've been making that same mistake for years.
That being the case, after visiting MS site for a knowledge tune-up, the GetObject returns instances in the order they were created. So, that will not be a help with multiple instances. Even so, I learned something, so I'm happy about that.

One last try.

Option Compare Database
Option Explicit

Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Private Sub cmdExport_Click()
'******************************************************************************
' Export data into an Excel spreadsheet.  The code is based on:
'http://accessjitsu.com/2015/09/13/code-listing-exporting-data-from-access-to-excel-part-4-formatting/
'******************************************************************************
On Error GoTo ErrProc

  Dim xlApp As Excel.Application    'Create an instance of Excel application
  Dim xlBook As Excel.Workbook      'Create a new Excel workbook
  Dim xlAtch As Excel.Worksheet      'Create a tab with Attachment details
  Dim strSQL As String              'SQL for the Attachment recordset
  Dim rsAtch As DAO.Recordset        'Attachment recordset
  Dim x As Integer                  'Counter for Attachment line numbers
  Dim Img As Excel.Shape            'Process the Image Attachments
  Dim Atch As OLEObject             'Process the non-Image Attachments
  Dim KeepTheseProcessesOpen As New Dictionary
  Dim PID As Long

  'Turn on the hourglass; the export takes a few seconds
  DoCmd.Hourglass (True)

  'add a list of current process ids to dictionary
  'we will not want to kill any of these
  Set KeepTheseProcessesOpen = GetExcelProcesses

  'Create an instance of Excel.  Keep it hidden until it is finished
  Set xlApp = New Excel.Application

  'add one more to the keep-open list
  GetWindowThreadProcessId xlApp.hwnd, PID
  KeepTheseProcessesOpen.Add PID, Null

  xlApp.Visible = False
  Set xlBook = xlApp.Workbooks.Add
  Debug.Print xlBook.Name
  xlBook.Worksheets.Add

  'Build the Image Reference SQL
  strSQL = "SELECT * FROM tblAttachments"

  'Open the recordset
  Set rsAtch = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)

  'Add a new worksheet
  Set xlAtch = xlBook.Worksheets(1)

  With xlAtch
    .Name = "Attachments"
    .Cells.Font.Name = "Calibri"
    .Cells.Font.Size = 11
      
    'Build Column Headings
    .Range("A1").Value = "Name"
    .Range("B1").Value = "Attachment"
    .Range("C1").Value = "Attachment Path"
    
    .Range("A2:A5").RowHeight = 65
    .Columns("B").ColumnWidth = 17
  
    'Populate the detail data
    x = 2   'Set initial row counter
    Do While Not rsAtch.EOF
      .Range("A" & x).Value = Nz(rsAtch!AttachmentName, "")
      .Range("C" & x).Value = Nz(rsAtch!attachmentpath, "")

      If rsAtch!AttachmentType = "Image" Then
                
        'Add the image; the initial size is set at 2000 and then resized below.
        'Otherwise, the image is blurry when expanded by the user
        Set Img = .Shapes.AddPicture(FileName:=rsAtch!attachmentpath, _
                  linktofile:=msoFalse, savewithdocument:=msoCTrue, _
                  Left:=.Range("B" & x).Left, Width:=2000, _
                  Top:=.Range("B" & x).Top, Height:=2000)
      
        'Resize the image
        Img.Width = .Range("B" & x).Width           'Width = cell width
        Img.Height = .Range("B" & x).Height         'Height = cell height
        Img.Placement = 1                           'Move and size with the cell
  
      Else 'non-image attachment
      
        Set Atch = .OLEObjects.Add(FileName:=rsAtch!attachmentpath, _
          iconindex:=0, _
          Link:=False, DisplayAsIcon:=True, IconFileName:=rsAtch!iconpath, _
          Left:=.Range("B" & x).Left, Width:=.Range("B" & x).Width, _
          Top:=.Range("B" & x).Top, Height:=.Range("B" & x).Height)
      

        Atch.Placement = 1                           'Move and size with the cell
    
      End If
    
      x = x + 1
      rsAtch.MoveNext
  
    Loop
  
    'Format the detail section as an Excel table
    .ListObjects.Add(xlSrcRange, .Range("$A$1:$C$" & x - 1), , xlYes).Name = "Attachments"
    .Range("Attachments[#All]").Select
    .ListObjects("Attachments").TableStyle = "TableStyleLight8"
  
    .Range("A2").Select     'Put the focus on the first data cell
    .Columns("A:C").AutoFit 'Autofit the column widths
  
  End With

ExitProc:

  On Error Resume Next
  DoCmd.Hourglass False   'Turn off the hourglass
  xlApp.Visible = True    'Set Excel to visible
  'Cleanup
  rsAtch.Close
  Set rsAtch = Nothing
  Set Img = Nothing
  Set Atch = Nothing

  'kill all Excel processes not in our list
  KillExcelProcesses KeepTheseProcessesOpen

  Exit Sub

ErrProc:
  MsgBox Err.Number & "; " & Err.Description, vbOKOnly, "Error"
  Resume ExitProc

End Sub

Private Function ExcelProcesses() As Object
    Dim WMI
    Set WMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
      Environ("COMPUTERNAME") & "\root\cimv2")
    
    Set ExcelProcesses = WMI.ExecQuery("select * from win32_process where Name = ""EXCEL.EXE""")
End Function

Private Function GetExcelProcesses() As Dictionary
    Dim ret As New Dictionary, Process As Object
  
    For Each Process In ExcelProcesses()
        ret.Add Process.ProcessId, Null
    Next
    Set GetExcelProcesses = ret
End Function

Private Sub KillExcelProcesses(ExceptForThese As Dictionary)
    Dim ret As New Dictionary, Process As Object
  
    For Each Process In GetExcelProcesses()
        If Not ExceptForThese.Exists(Process.ProcessId) Then Process.Terminate
    Next
End Sub