【问题标题】:Outlook Macro If Else StatementOutlook 宏 If Else 语句
【发布时间】:2018-09-20 17:07:46
【问题描述】:

我的代码根据附件名称对电子邮件进行排序。我需要 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

【问题讨论】:

    标签: vba if-statement outlook outlook-2013


    【解决方案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
    

    【讨论】:

    • 谢谢@0m3r。该代码实际上有效。但是当我现在运行代码时,我收到此错误:“运行时错误'-2147221223(80040119)':项目被复制而不是移动,因为无法删除原始项目。未知错误”代码中发生错误: next 将电子邮件移动到特定文件夹 objMail.Move objTargetFolder End 如果我删除第二个 objMail.Move objTargetFolder 我会得到“for without next error”。如何将代码更改为不需要 for each, next 语句?我怎样才能让它正常运行?
    • 哈!有用。我只需指定全部小写的附件名称。 @0m3r
    • 我正在尝试使用此宏,但它在 Office 365 中不起作用。有什么需要更改的吗?
    • 很遗憾没有。它只是没有排序。
    • 发布新问题:OutLook Macro If Else Statement Office 365。谢谢!
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2019-04-09
    • 1970-01-01
    • 2017-02-05
    • 2015-06-24
    • 1970-01-01
    • 2015-07-06
    • 2012-08-05
    相关资源
    最近更新 更多