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

此代码中所做的更改

对象声明
对象已关闭且已正确发布

<强>代码

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

使用VBA在Outlook中的ItemAdd事件 - 导致听众随机“取消设置”的事情

1 个答案: