Outlook Macro If Else Statement

Question

My code sorts emails based on attachment name. I need help with the else statement.

I want the emails that do not meet the parameters to move to the main inbox.

Right now any thing that does not meet parameters just moves to another folder.

What is the correct syntax?

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

0m3r · Accepted Answer · 2018-04-12T00:03:20.960

You don't need to set the Inbox, Items are already in Inbox- all your doing is checking the newly add items to inbox has attachment name then move it

So your if statement should look like this

    '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

Full Code should look like this

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

Thank you @0m3r. The code actually works. But when I run the code now I get this error: "Run-time error '-2147221223 (80040119)': The Items were copied instead of moved because the original items cannot be deleted. Unknown error" Error happening here in the code: next Move the email to specific folder objMail.Move objTargetFolder End If If I remove the second objMail.Move objTargetFolder I get a "for without next error". How can I alter the code to not need a for each, next statement? How do i get this to run with no error? — Lefty25, Apr 11 '18 at 21:16
Ha! It works. I just have to specify the attachment name in all lowercase. @0m3r — Lefty25, Apr 12 '18 at 19:19
Im trying to use this macro but its not working in Office 365. Is there anything that needs to be changed? — Lefty25, Apr 18 '19 at 20:03
New question posted: OutLook Macro If Else Statement Office 365. Thank you! — Lefty25, Apr 18 '19 at 23:27
Now I have, I will be home soon and test it on my office 365 — 0m3r, Apr 20 '19 at 20:27

Outlook Macro If Else Statement

1 Answers1