使用VBA的Outlook中的ItemAdd事件 - 引起聽衆隨機「取消設置」的東西

Question

我正在使用VBA與特定子文件夾上的事件偵聽器在該文件夾收到電子郵件時運行宏。它是完美的，只有一個例外。我正在設置要聽的對象，但他們似乎隨機地被設置爲「無」，這阻止了聽衆「聆聽」。下面是我使用的設置監聽器和觸發宏代碼：

Public WithEvents myOLItems As Outlook.Folder 
Public WithEvents myTDLoanEmails As Outlook.Items 

Private Sub Application_Startup() 
    Set myOLItems = Outlook.Session.GetDefaultFolder(olFolderInbox) 
    Set myTDLoanEmails = myOLItems.Folders("Trust Loan Collateral Tracking Text Files").Items 
End Sub 

Private Sub myTDLoanEmails_ItemAdd(ByVal Item As Object) 
    Call getAttachments 
    Call runTextToExcel 
End Sub 

「runTextToExcel」創建一個Excel應用程序，打開一個Excel文件，運行在該文件中的宏，然後關閉文件和應用程序。我認爲錯誤可能源於文件/ Excel應用程序沒有完全關閉，因爲如果我在完成後立即再次運行Outlook宏，它將無法找到Excel文件，儘管尚未移動。這會導致一個錯誤，我認爲這可能會使聽衆「不安」。這可能嗎？

如果有幫助（或者你很好奇），這裏是被稱爲上述兩個潛艇：

Private Sub runTextToExcel() 
Dim xlApp As Object 
Dim oWbk As Workbook 
Dim TextToExcelFile As Workbook 

Set xlApp = CreateObject("Excel.Application") 
With xlApp 
    .Visible = True 
    .EnableEvents = False 
End With 

sFile = "Loan Text Files to Excel Converter_v004.xlsm" 
sPath = "K:\Shared\Text to Excel\" 

bOpened = False 
For Each oWbk In Workbooks 
    If oWbk.Name = sFile Then bOpened = True 
Next oWbk 
If bOpened = False Then Workbooks.Open (sPath & sFile) 

xlApp.Run "'" & sFile & "'!LoanTextFilesToExcel" 

xlApp.DisplayAlerts = False 
Workbooks(sFile).Close (True) 
xlApp.DisplayAlerts = True 
xlApp.Quit 

End Sub 


Private Sub getAttachments() 
    On Error GoTo GetAttachments_err 

Dim ns As NameSpace 
Dim Inbox As MAPIFolder 
Dim TDLoanEmails As MAPIFolder 
Dim Item As Object 
Dim Atmt As Attachment 
Dim FileName As String 
Dim i As Integer 

Set ns = GetNamespace("MAPI") 
Set Inbox = ns.GetDefaultFolder(olFolderInbox) 
Set TDLoanEmails = Inbox.Folders("Trust Loan Collateral Tracking Text Files") 

For Each Item In TDLoanEmails.Items 
    If Item.Attachments.Count > 3 Then 
     If Day(Item.ReceivedTime) = Day(Date) And Month(Item.ReceivedTime) = Month(Date) And Year(Item.ReceivedTime) = Year(Date) Then 
      For Each Atmt In Item.Attachments 
       If Right(Atmt.FileName, 4) = ".TXT" Then 
        FileName = "K:\Shared\Text to Excel\Text Files\" & Left(Atmt.FileName, Len(Atmt.FileName) - 4) & "-" & Format(Date, "mmddyyyy") & ".txt" 
        Atmt.SaveAsFile FileName 
       End If 
      Next Atmt 
     End If 
    End If 
Next Item 

GetAttachments_exit: 
    Set Atmt = Nothing 
    Set Item = Nothing 
    Set ns = Nothing 
    Exit Sub 

GetAttachments_err: 
    MsgBox "An unexpected error has occurred." _ 
     & vbCrLf & "Please note and report the following information." _ 
     & vbCrLf & "Macro Name: GetAttachments" _ 
     & vbCrLf & "Error Number: " & Err.Number _ 
     & vbCrLf & "Error Description: " & Err.Description _ 
     , vbCritical, "Error!" 
    Resume GetAttachments_exit 
End Sub 

謝謝！

Answer 1

不知道是不是因爲runTextToExcel而是現有runTextToExcel的備份並用此替換它。

我相信你正在使用Late Binding

在這段代碼的更改

1. 對象申報
2. 對象關閉和釋放正常

代碼

Private Sub runTextToExcel() 
    Dim xlApp As Object 
    Dim oWbk As Object, wb As Object 
    Dim TextToExcelFile As Object '<~~ Are you using this anywhere? 
    Dim bOpened As Boolean 

    Set xlApp = CreateObject("Excel.Application") 

    With xlApp 
     .Visible = True 
     .EnableEvents = False 
    End With 

    sFile = "Loan Text Files to Excel Converter_v004.xlsm" 
    sPath = "K:\Shared\Text to Excel\" 

    bOpened = False 

    For Each oWbk In xlApp.Workbooks 
     If oWbk.Name = sFile Then bOpened = True 
    Next oWbk 

    If bOpened = False Then Set wb = xlApp.Workbooks.Open(sPath & sFile) 

    xlApp.Run "'" & sFile & "'!LoanTextFilesToExcel" 

    xlApp.DisplayAlerts = False 
    wb.Close (True) 
    xlApp.DisplayAlerts = True 
    xlApp.Quit 

    Set wb = Nothing 
    Set xlApp = Nothing 
End Sub