代码不适用于其他发件人

时间:2017-02-08 13:25:36

标签: vba email outlook

每当收到包含特定值的主题的电子邮件并将电子邮件移动到特定文件夹时,我都会创建一个日志文件(文本)。该代码适用于一个电子邮件发件人,并且当另一个发件人使用相同主题发送时不起作用。目的是发送具有类似主题的电子邮件的任何人都应该由代码处理。

以下是ThisOutlookSession中的代码。

Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
    Set olInboxItems = Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

    On Error Resume Next

    Dim olMailItem As MailItem
    Dim strAttachmentName As String

    If TypeOf Item Is MailItem Then
        Set olMailItem = Item

        If olMailItem.Attachments.Count = 0 _
        And InStr(olMailItem.Subject, "Exception Noted at FTD") > 0 Then

           'Create LogFile to a network folder
            Dim strFile_Path As String

            strFile_Path = "\\10.53.66.30\cbd\Status\" & olMailItem.SenderName + "StaffLogfile.txt"
            Open strFile_Path For Append As #1
            Write #1, Format(olMailItem.ReceivedTime, "dd-mmm-yyyy | hh:mm | ") + olMailItem.SenderName + " | " + olMailItem.Subject
            Close #1

        End If

        'Move to Exception Folder
        Dim fldr As Outlook.MAPIFolder

        If olMailItem.Attachments.Count = 0 _
        And InStr(olMailItem.Subject, "Exception Noted at FTD") > 0 Then
           Set fldr = Outlook.Session.Folders("Archives").Folders("Personal Folder").Folders("FTD").Folders("Exception Report")
                olMailItem.Move fldr
        End If

    End If

End Sub

1 个答案:

答案 0 :(得分:0)

谢谢你们帮我解决问题。我找到了这个问题,现在这对我来说非常合适。

早期版本:

If olMailItem.Attachments.Count = 0 _
    And InStr(olMailItem.Subject, "Exception Noted at FTD") > 0 Then

更正版本:

If InStr(olMailItem.Subject, "Exception Noted at FTD") > 0 Then

通过此更正,代码现在适用于所有传入消息。我不知道附件检查声明导致问题的原因。由于我已经要求相关工作人员在没有任何附件的情况下发送电子邮件,而是将内容放在正文中,这将以某种方式解决我的问题。再次感谢您的帮助。