Outlook Macro If Outlook语句

Question

我的代码根据附件名称对电子邮件进行排序。我需要别人的帮助。

我希望不符合参数的电子邮件移动到主收件箱。

现在，任何不满足参数的东西只会移动到另一个文件夹。

正确的语法是什么？

Public WithEvents objMails As Outlook.Items

Private Sub Application_Startup()
Set objMails = Outlook.Application.Session.GetDefaultFolder (olFolderInbox).Items

End Sub

Private Sub objMails_ItemAdd(ByVal Item As Object)

Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment
Dim strAttachmentName As String
Dim objInboxFolder As Outlook.Folder
Dim objTargetFolder As Outlook.Folder

"Ensure the incoming item is an email"
If TypeOf Item Is MailItem Then
   Set objMail = Item
   Set objAttachments = objMail.Attachments

   "Check if the incoming email contains one or more attachments"

   If objAttachments.Count > 0 Then
      For Each objAttachment In objAttachments
          strAttachmentName = objAttachment.DisplayName
          Set objInboxFolder = Application.Session.GetDefaultFolder(olFolderInbox)

          "Check the names of all the attachments"
          "Specify the target folders"

          If InStr(LCase(strAttachmentName), "some attachment name") > 0 Then
             Set objTargetFolder = objInboxFolder.Folders("Target Folder")
             Else: Set objTargetFolder = objInboxFolder.Folders("Target Folder 2")
     End If
     Next
     Move the email to specific folder
      objMail.Move objTargetFolder
   End If
End If

Set objMail = Nothing
Set objAttachments = Nothing
Set objAttachment = Nothing
Set objInboxFolder = Nothing
Set objTargetFolder = Nothing

End Sub

Answer 1

您不需要设置收件箱，项目已经在收件箱中-您所做的一切是检查新添加的项目收件箱有附件名称，然后移动它

所以您的if语句应该如下所示

    'Check if the incoming email contains one or more attachments"
    If objAttachments.Count > 0 Then
        For Each objAttachment In objAttachments
           strAttachmentName = objAttachment.DisplayName

           Set objInboxFolder = Application.Session.GetDefaultFolder(olFolderInbox)

            If InStr(LCase(strAttachmentName), "attachment name") > 0 Then
                Set objTargetFolder = objInboxFolder.Folders("Target Folder")
                objMail.Move objTargetFolder
            End If
        Next
    End If

完整代码应该如下所示

Option Explicit
Public WithEvents objMails As Outlook.Items
Private Sub Application_Startup()
    Set objMails = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub objMails_ItemAdd(ByVal Item As Object)
    Dim objMail As Outlook.MailItem
    Dim objAttachments As Outlook.Attachments
    Dim objAttachment As Outlook.Attachment
    Dim strAttachmentName As String
    Dim objInboxFolder As Outlook.Folder
    Dim objTargetFolder As Outlook.Folder

    Debug.Print "Items Add"

    '"Ensure the incoming item is an email"
    If TypeOf Item Is MailItem Then
        Set objMail = Item
        Set objAttachments = objMail.Attachments

        '   "Check if the incoming email contains one or more attachments"
        If objAttachments.Count > 0 Then
            For Each objAttachment In objAttachments
                strAttachmentName = objAttachment.DisplayName
                Debug.Print strAttachmentName

                Set objInboxFolder = Application.Session.GetDefaultFolder(olFolderInbox)

                If InStr(LCase(strAttachmentName), "attachment name") > 0 Then
                    Set objTargetFolder = objInboxFolder.Folders("Target Folder")
                    objMail.Move objTargetFolder
                    Debug.Print objAttachment.DisplayName
                End If
            Next
        End If
    End If

    Set objMail = Nothing
    Set objAttachments = Nothing
    Set objAttachment = Nothing
    Set objInboxFolder = Nothing
    Set objTargetFolder = Nothing
End Sub