VBA code to remove all mails from a specified Folders in Excel

Sameer_Kuppanath_Sultan 

If you want to move only messages that have attachments:

Private Sub CommandButton1_Click()
    Dim olApp As Object
    Dim olMail As Object
    Dim olItems As Object
    Dim ns As Object
    Dim olFolder As Object
    Dim olFolderSub As Object
    Dim olInbox As Object
    Dim j As Integer
    Dim Strfolder As String
    Dim FilePath As String

    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number = 429 Then
        Set olApp = CreateObject("Outlook.Application")
    End If

    Strfolder = "C:\Work Area\OutlookAttachments"

    Set ns = olApp.GetNamespace("MAPI")
    Set olFolder = ns.Folders("xyz@company.com").Folders("Inbox").Folders("Work in Progress (FC)")
    Set olInbox = ns.GetDefaultFolder(6)
    Set olFolderSub = olInbox.Folders("Temp")
    Set olItems = olFolder.Items

    For Each olMail In olItems
        If olMail.Attachments.Count > 0 Then
            For j = 1 To olMail.Attachments.Count
                FilePath = Strfolder & "\" & olMail.Attachments.Item(j).Filename
                olMail.Attachments.Item(j).SaveAsFile FilePath
            Next j
            olMail.UnRead = False
            olMail.Move olFolderSub
        End If
    Next olMail

    Set olFolder = Nothing
    Set olItems = Nothing
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

If you want to move ALL messages in the folder:

Private Sub CommandButton1_Click()
    Dim olApp As Object
    Dim olMail As Object
    Dim olItems As Object
    Dim ns As Object
    Dim olFolder As Object
    Dim olFolderSub As Object
    Dim olInbox As Object
    Dim j As Integer
    Dim Strfolder As String
    Dim FilePath As String

    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number = 429 Then
        Set olApp = CreateObject("Outlook.Application")
    End If

    Strfolder = "C:\Work Area\OutlookAttachments"

    Set ns = olApp.GetNamespace("MAPI")
    Set olFolder = ns.Folders("xyz@company.com").Folders("Inbox").Folders("Work in Progress (FC)")
    Set olInbox = ns.GetDefaultFolder(6)
    Set olFolderSub = olInbox.Folders("Temp")
    Set olItems = olFolder.Items

    For Each olMail In olItems
        If olMail.Attachments.Count > 0 Then
            For j = 1 To olMail.Attachments.Count
                FilePath = Strfolder & "\" & olMail.Attachments.Item(j).Filename
                olMail.Attachments.Item(j).SaveAsFile FilePath
            Next j
        End If
        olMail.UnRead = False
        olMail.Move olFolderSub
    Next olMail

    Set olFolder = Nothing
    Set olItems = Nothing
    Set olMail = Nothing
    Set olApp = Nothing
End Sub