0

我在特定子文件夹上使用带有事件侦听器的 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

谢谢！

4

1 回答 1

0

不确定是否是因为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
于 2013-02-20T17:12:36.423 回答