Verwaiste Excel-Prozess mit Outlook VBA

Question

Guten Tag,

Ich habe mit meinem Ausblick vba in ein Problem laufen, wo ich Probleme die Excel-Prozess endet, dass ich offen nennen. Ich habe mir ein paar verschiedene Lösungen angeschaut, wie das Setzen von Variablen auf Nothing am Ende und das Verwenden von Statements nach allen Variablen, aber ich habe eine Blockade gefunden und der verwaiste Prozess scheint Probleme zu verursachen, wenn ich Excel immer wieder aufruft. Wenn mich jemand in die richtige Richtung führen würde, wo ich falsch liege, würde ich es sehr schätzen. Kurz gesagt, der Code soll den Anhang herunterladen, einige Zellenwerte aus dem Anhang in eine Arbeitsmappe auf meinem Computer kopieren und die Dokumente speichern und schließen.

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 

Vielen Dank im Voraus!

Answer 1

Es gibt einige empfohlene Regeln, die Sie in dieser Art von Anwendungen anwenden können.

1- Bevor Sie Excel öffnen, prüfen Sie, ob Excel bereits geöffnet ist und die laufende Instanz erhalten. Sie können eine benutzerdefinierte Routine erstellen, das zu tun:

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- Machen Sie die Anwendung sichtbar, zumindest in der Phase, wo man noch gerade schreiben und Ihren Code debuggen.

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

3- Sie können schließlich Verknüpfung, um die Zwei-Phasen (erstellen app, öffnen doc) mit nur einem Schritt

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

Dies wird entweder ein bereits geöffnetes Dokument Instanz erhalten oder öffnen, wenn nicht. Sie können das Anwendungsobjekt später als wb.Application abrufen.

4- Stellen Sie sicher, dass Sie die Fehlersituationen richtig handhaben, in denen alle Pfade die Excel-Anwendung schließen, einschließlich solcher, die aus einem Fehler resultieren.

5- Da die von Ihnen verwendete Anwendung vorübergehend ist, behalten Sie sie bei DisplayAlerts = False. Wie ich sehe, setzen Sie es vor dem Beenden auf DisplayAlerts = true zurück. Dies ist eine Quelle von Kopfschmerzen. Stellen Sie sich die "nicht sichtbare" Anwendung vor, die mit einer Warnmeldung blockiert wird? Ich schlage vor, dass Sie diese Linie fallen lassen (behalten Sie false bei).

6- Ihre Bereiche Qualifizieren und Objektvariablen

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