带有 Outlook VBA 的孤立 Excel 进程

Question

我无法结束使用 Outlook VBA 打开的 Excel 进程。

我研究了一些解决方案，例如在最后将变量设置为 Nothing 并在所有变量之后使用 With 语句。

当我一遍又一遍地调用 Excel 时，孤立的进程似乎会导致问题。

该代码假设下载附件，将一些单元格值复制到工作簿中，保存并关闭文档。

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

您可以在此类应用程序中应用一些推荐规则。

1- 在打开 Excel 之前，检查 Excel 是否已经打开并获取正在运行的实例。 您可以创建一个自定义例程来做到这一点：

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- 使应用程序可见，至少在您仍在编写和调试代码的阶段。

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

3-您最终只需一步即可缩短两个阶段（创建应用程序，打开文档）

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

这将获得一个已经打开的文档实例，或者如果没有打开它。 您可以稍后将应用程序对象作为wb.Application 。

4- 确保正确处理错误情况，所有路径都将关闭 Excel 应用程序，包括由错误导致的路径。

5- 由于您使用的应用程序是临时的，请将其保持为DisplayAlerts = False状态。 正如我所见，您在退出之前将其重置为DisplayAlerts = true 。 这是头痛的根源。 想象一下被一些警报消息框阻止的“不可见”应用程序？ 我建议你放弃那条线（保持false ）。

6- 限定范围和对象变量

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