Question

我的代码根据附件名称对电子邮件进行排序。我需要有关else语句的帮助。

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

现在任何不符合参数的东西都会移动到另一个文件夹。

正确的语法是什么？

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

Outlook宏如果其他声明

1 个答案: