Orphaned Процесс Excel с VBA Перспективы

Question

Доброго днем,

Я столкнулся с проблемой, с моим прогнозом УВОЙ, где у меня возникли проблемы окончания процесса первенствовать, что я называю открытым. Я рассмотрел несколько различных решений, таких как установка переменных в Nothing в конце и использование с операторами после всех переменных, но я попал в дорожный блок, и потерянный процесс, похоже, вызывает проблемы, когда я вызываю 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- Вы можете в конечном итоге накоротко две фазы (создать приложение, открыть DOC) только с одним шагом

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