Осиротевший процесс Excel с Outlook VBA

У меня возникают проблемы с завершением процесса Excel, который я называю открытым с помощью Outlook VBA.

Я рассмотрел несколько решений, таких как установка переменных в 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

person David Betts    schedule 31.01.2017    source источник


Ответы (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
person A.S.H    schedule 31.01.2017