กระบวนการ 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)

นี่จะได้รับอินสแตนซ์เอกสารที่เปิดอยู่แล้วหรือเปิดหากไม่เป็นเช่นนั้น คุณสามารถรับ Application Object ในภายหลังเป็น 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