Moving a mail from inbox to a specific folder

Question

This code saves the attachment from Outlook to a specific folder in my PC.

I need to move the selected mail in Outlook inbox to a folder in Outlook.

Ultimately, I will save the attachment and move this mail to a folder in Outlook.

Sub INC_Data()

    Dim ol As Object    'Outlook.Application
    Dim ns As Object    'Outlook.Namespace
    Dim fol As Object   'Outlook.Folder
    Dim i As Object
    Dim mi As Object    'Outlook.MailItem
    Dim at As Object    'Outlook.Attachment
    Dim fso As Object   'Scripting.FileSystemObject
    Dim dir As Object   'Scripting.Folder
    Dim dirName As String
    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object
    Dim f As Integer
    
    'Some Set Ups
    Set fso = CreateObject(Class:="Scripting.FileSystemObject")
    Set ol = CreateObject(Class:="Outlook.Application")
    Set ns = ol.GetNamespace("MAPI")
    Set fol = ns.GetDefaultFolder(olFolderInbox)
    
    'Finding the search item from Oulook Inbox
    For Each i In fol.Items
        If i.Class = 43 Then
            Set mi = i
            If mi.Attachments.Count > 0 And InStr(mi.SenderEmailAddress, "xxxxxxx@inc.ae") Then
                dirName = "D:\XYZ "
                If fso.FolderExists(dirName) Then
                    Set dir = fso.GetFolder(dirName)
                Else
                    Set dir = fso.Createfolder(dirName)
                End If
                'Saving Attachment to a folder
                For Each at In mi.Attachments
                    If Right(at.Filename, 4) = "xlsm" Then
                        at.SaveAsFile dir.Path & "\" & Range("Ad2").Text & ".xlsm"
                    End If
                Next at
            End If
        End If
    Next i
        
End Sub

Answer 1

First, delcare an object variable so that we can assign it the destination folder...

Dim olMoveToFolder As Object 'Outlook.Folder

Then, assign the destination folder to the variable. So, for example, depending on your folder structure, something like this...

Set olMoveToFolder = ns.Folders("Outlook").Folders("DestinationFolderName")

or

Set olMoveToFolder = fol.Folders("DestinationFolderName")

Then, add the following line, after saving the attachments, to move your email to the destination folder...

mi.Move olMoveToFolder

EDIT

While I haven't tested it, I have amended your macro to include the following...

1. The statement Option Explicit has been added to force the explicit declaration of variables to help catch any potential errors. Note that this statement must be place at the very top of the module, before any procedure.

2. Some of the variable names have been renamed in the interest of clarity.

3. The variable dir has been removed since it's not really needed, and since it can be confused with the function Dir() .

4. The variable dirName is set prior to looping through your mail items.

5. The constant olFolderInbox has been replaced with the value 6 , since you are using late binding.

Here's your macro, amended accordingly...

Option Explicit

Sub INC_Data()
    Dim ol As Object            'Outlook.Application
    Dim ns As Object            'Outlook.Namespace
    Dim inboxFol As Object      'Outlook.Folder
    Dim moveToFolder As Object  'Outlook.Folder
    Dim itm As Object
    Dim mi As Object            'Outlook.MailItem
    Dim att As Object           'Outlook.Attachment
    Dim fso As Object           'Scripting.FileSystemObject
    Dim dirName As String
     
    'Some Set Ups
    Set fso = CreateObject(Class:="Scripting.FileSystemObject")
    Set ol = CreateObject(Class:="Outlook.Application")
    Set ns = ol.GetNamespace("MAPI")
    Set inboxFol = ns.GetDefaultFolder(6) 'olFolderInbox
    Set moveToFolder = ns.Folders("MainFolderName").Folders("MoveToFolderName") 'change the folder names accordingly
    
    dirName = "D:\XYZ"
    If Not fso.FolderExists(dirName) Then
        fso.CreateFolder dirName
    End If

    'Finding the search item from Oulook Inbox
    For Each itm In inboxFol.Items
        If itm.Class = 43 Then
            Set mi = itm
            If mi.Attachments.Count > 0 And InStr(mi.SenderEmailAddress, "xxxxxxx@inc.ae") Then
                'Saving Attachments to a folder
                For Each att In mi.Attachments
                    If Right(att.Filename, 4) = "xlsm" Then
                        att.SaveAsFile dirName & "\" & Range("Ad2").Text & ".xlsm"
                    End If
                Next att
                'Move mail item to destination folder
                mi.Move moveToFolder
            End If
        End If
    Next itm
End Sub