带有 Outlook VBA 的孤立 Excel 进程

Question

I am having trouble ending the Excel process that I call open with Outlook VBA.

I have looked into a few solutions like setting variables to Nothing at the end and using With statements after all variables.

The orphaned process seems to be causing problems when I call Excel over and over again.

The code is suppose to download the attachment, copy some cell values into a workbook, save and close the documents.

Private WithEvents myOlItems  As Outlook.Items   

Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
    
Private Sub myOlItems_ItemAdd(ByVal item As Object)    
    Dim Msg As Outlook.MailItem
    Dim msgattach As Object
    Dim wb As Workbook
    Dim myXLApp As Excel.Application
    Dim filepath As String
    Dim filepathone As String
    Dim filepathtwo As String
    Dim wbhome As Worksheet
    Dim comp As String
             
    Dim wbtemp As Workbook
    Dim testcode As Workbook
    Dim matrix As Worksheet
    Dim testflr As Worksheet
           
    If TypeName(item) = "MailItem" Then
        Set Msg = item
         
        If Left(Msg.Subject, 14) = "SES Gas Matrix" Then
            Set myXLApp = CreateObject("Excel.Application")
            myXLApp.DisplayAlerts = False
            If Msg.Attachments.Count <> 0 Then
                For Each msgattach In Msg.Attachments
                    If Right(msgattach.FileName, 5) = ".xlsx" Then
                        filepath = "G:\Betts\Floor Matricies\FIFOs\" & Format(Now(), "YYYYMMDD") & " - " & "Gas Rates" & Right(msgattach.FileName, 5)
                        msgattach.SaveAsFile filepath
                    End If
                Next
            End If
            Set msgattach = Nothing
            Set wbtemp = Workbooks.Open(filepath, UpdateLinks:=3)
            Set matrix = wbtemp.Sheets("Sheet1")
            wbtemp.Activate
            filepathtwo = Left(filepath, Len(filepath) - 5)
            
            matrix.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
              filepathtwo & ".pdf" _
              , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
              :=False, OpenAfterPublish:=False
            
            filepathone = "http://intranet/Pricing%20and%20Rates/Floor%20Matrices/FIFOs/" & Format(Now(), "YYYYMMDD") & "%20-%20Gas%20Rates.pdf"
            matrix.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
              filepathone _
              , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
              :=False, OpenAfterPublish:=False
            
            Dim rangeb5l9 As Range
            Set rangeb5l9 = matrix.Range("B5:L9")
            rangeb5l9.Copy
            Set rangeb5l9 = Nothing
            
            On Error GoTo ErrorHandler
            
            Set testcode =   Workbooks.Open(FileName:="G:\Betts\ReturnOnInvestment_Master_Backup Testcode.xlsm", UpdateLinks:=3)
            Set testflr = testcode.Sheets("Floor Pricing")
            
            Dim rangea44 As Range
            Dim rangeb93 As Range
            Dim rangeb94 As Range
            
            Set rangea44 = testflr.Range("A44")
            rangea44.PasteSpecial xlPasteValues
            myXLApp.CutCopyMode = False
            Set rangea44 = Nothing
            
            Set rangeb93 = testflr.Range("B93")
            rangeb93 = "Yes"
            
            wbtemp.Close
    
            Set wbtemp = Nothing
            
            Kill (filepath)
            
            Set rangeb94 = testflr.Range("B94")
            
            If rangeb93 = "Yes" And rangeb94 = "Yes" Then
                testcode.Application.Run ("Module34.OFVT")
                rangeb93 = "No"
                rangeb94 = "No"
            End If
    
            Set rangeb94 = Nothing
            
            Set rangeb93 = Nothing
            
            Set testflr = Nothing
            
            testcode.Close savechanges:=True
            Set testcode = Nothing
    
            Set matrix = Nothing
    
            myXLApp.DisplayAlerts = True
    
            myXLApp.Quit
    
            Set myXLApp = Nothing
            Msg.UnRead = False
            
        End If
        Set Msg = Nothing
    End If
      
    'test area
    Set item = Nothing
    
    Exit Sub
    
ErrorHandler:
    If (Err.Number = 50290) Then Resume
    Stop
    Resume
    
End Sub

Answer 1

There are a few recommended rules that you could apply in this kind of applications.

1- Before opening Excel, check if Excel is already open and get the running instance. You can create a custom routine to do that:

Function getExcelApp() As Excel.Application
    On Error Resume Next
    Set getExcelApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then Set getExcelApp = CreateObject("Excel.Application")
End Function

2- Make the application visible, at least in the phase where you're still writing and debugging your code.

Set myXLApp = getExcelApp ' <-- get it or create it
myXLApp .Visible = true ' <-- useful at least in the development phase

3- You can eventually shortcut the two-phases (create app, open doc) with just one step

Dim wb as Excel.Workbook
Set wb= GetObject(filepath)

This will either get an already open document instance or open it if not. You can later get the Application Object as wb.Application .

4- Make sure you correctly handle the error situations to that all paths will close the Excel application, including those resulting from an error.

5- Since the application you're using is temporary, keep it with DisplayAlerts = False state. As I see you reset it to DisplayAlerts = true before quitting. This is source of headache. Imagine the "non-visible" application blocked with some alert messagebox? I suggest you drop that line (keep false ).

6- Qualify your ranges and object variables

Set wbtemp = myXlApp.Workbooks.Open(filepath, 3, True) '<-- better than using the unqualified Workbooks