Friday, September 24, 2021

Move mails filtered by date range to a specified folder in out using VBA

 Sub movemailtofolder()
    Dim ol As Object        'Outlook.Application
    Dim ns As Object        'Outlook.Namespace
    Dim inboxFol As Object  'Outlook.Folder
    Dim subFol 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
     
     
    Dim xDate As Date
    Dim DateStart As Date
    Dim DateEnd As Date
    'get date 1 day back
    DateStart = Date - 1
    'get todays date

    DateEnd = Date

Dim datetocheck 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.Folders("allsourav@gmail.com").Folders("Inbox") 'olFolderInbox
    Set subFol = inboxFol.Folders("test")
    
'    dirName = "D:\XYZ"
'    If Not fso.FolderExists(dirName) Then
'        fso.CreateFolder dirName
'    End If


'search by date and time

datetocheck = "[ReceivedTime] >= '" & Format(DateStart, "ddddd h:nn AMPM") & "' And [ReceivedTime] <= '" & Format(DateEnd, "ddddd h:nn AMPM") & "'"
MsgBox (datetocheck)

    'Finding the search item from Oulook Inbox
    For Each itm In inboxFol.Items.Restrict(datetocheck)
        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 subfolder
'                mi.Move subFol
'            End If

             mi.Move subFol
        End If
    Next itm
End Sub

 

Source:https://techcommunity.microsoft.com/t5/excel/vba-moving-a-mail-from-inbox-to-a-specific-folder/m-p/1926973

No comments:

Post a Comment