Proses Excel Yatim dengan Outlook VBA

Saya mengalami kesulitan mengakhiri proses Excel yang saya sebut terbuka dengan Outlook VBA.

Saya telah mencari beberapa solusi seperti menyetel variabel ke Nothing di akhir dan menggunakan pernyataan With setelah semua variabel.

Proses yatim piatu tampaknya menyebabkan masalah ketika saya memanggil Excel berulang kali.

Kode tersebut seharusnya mengunduh lampiran, menyalin beberapa nilai sel ke dalam buku kerja, menyimpan dan menutup dokumen.

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 sumber


Jawaban (1)


Ada beberapa aturan yang direkomendasikan yang dapat Anda terapkan dalam aplikasi semacam ini.

1- Sebelum membuka Excel, periksa apakah Excel sudah terbuka dan jalankan instance. Anda dapat membuat rutinitas khusus untuk melakukan itu:

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- Jadikan aplikasi terlihat, setidaknya pada fase saat Anda masih menulis dan men-debug kode Anda.

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

3- Anda akhirnya dapat mempersingkat dua fase (membuat aplikasi, membuka dokumen) hanya dengan satu langkah

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

Ini akan mendapatkan contoh dokumen yang sudah terbuka atau membukanya jika belum. Nanti Anda bisa mendapatkan Objek Aplikasi sebagai wb.Application.

4- Pastikan Anda menangani situasi kesalahan dengan benar sehingga semua jalur akan menutup aplikasi Excel, termasuk jalur yang diakibatkan oleh kesalahan.

5- Karena aplikasi yang Anda gunakan bersifat sementara, pertahankan status DisplayAlerts = False. Seperti yang saya lihat, Anda menyetel ulang ke DisplayAlerts = true sebelum berhenti. Ini adalah sumber sakit kepala. Bayangkan aplikasi "tidak terlihat" diblokir dengan kotak pesan peringatan? Saya sarankan Anda menghilangkan baris itu (pertahankan false).

6- Kualifikasi rentang dan variabel objek Anda

Set wbtemp = myXlApp.Workbooks.Open(filepath, 3, True) '<-- better than using the unqualified Workbooks
person A.S.H    schedule 31.01.2017