Showing posts with label Filtering mails between two dates using restrict in outlook using vba. Show all posts
Showing posts with label Filtering mails between two dates using restrict in outlook using vba. Show all posts

Thursday, September 23, 2021

Filtering mails between two dates using restrict in outlook using vba

 
Sub findemail_working()
Dim olApp, mail As Object
Set olApp = CreateObject("Outlook.Application")
Dim olFolder As Outlook.MAPIFolder
Dim count As Integer
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

'MsgBox (xDate)
count = 0
Set olFolder = olApp.GetNamespace("MAPI").Folders("allsourav@gmail.com")
'If (olFolder.Folders.count > 0) Then
'    For Each Folder In olFolder.Folders
'        MsgBox (Folder.Name)
'
'    Next
'End If
'Set olFolder = olApp.GetNamespace("MAPI").Folders("allsourav@gmail.com").Folders("[Gmail]")
Set olFolder = olApp.GetNamespace("MAPI").Folders("allsourav@gmail.com").Folders("Inbox")
'If (olFolder.Folders.count > 0) Then
'    For Each Folder In olFolder.Folders
'        MsgBox (Folder.Name)
'
'    Next
'End If
'Set olFolder = olFolder.Folders("Inbox")

Dim itmemail As Outlook.MailItem

'numeral
'Set itmemail = filteredList.Find("[Importance]=2") 'mail with high importance
'we can use a variable like this
'strFind = "[Importance]=2"

'boolean
'strFind = "[UnRead]=False"

'search by date and time

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

'For Each i In olFolder.Items.Restrict(datetocheck)
'
'    ' If the email is an Outlook email
'        If i.Class = olMail Then
'
'            Set mi = i
'                UserForm1.Show
'            ' If there are more than 0 attachments, ie, if it finds an attachment
'                If mi.Attachments.count > 0 Then
'
'
'                    For Each at In mi.Attachments
'                    'Debug.Print mi.SenderName & " " & mi.ReceivedTime ' <- uncomment this part if you need to debug (remember to open the "immediate" window also
'                        ' Look for attachments that contain ".xls" (this will also pick up ".xlsx" and ".xlsm" etc
'                        If InStr(LCase(at.Filename), ".xls") > 0 Then
'                            ' Tell the script where to save the file and what details need to be appeneded to the file name to make it a unique name
'                            at.SaveAsFile "\\xxxx\xxxxx\xxxxx\" & Format(mi.ReceivedTime, "yyyy-mm-dd hh-nn-ss") & at.Filename
'
'                        Else
'
'                        ' literally do nothing (it's probably not needed but added just in case)
'
'                        End If
'
'
'                    Next at
'
'                End If
'
'        End If
'    Next i
For Each i In olFolder.Items.Restrict(datetocheck)

    ' If the email is an Outlook email
        If i.Class = olMail Then

           Debug.Print i.Subject, i.SenderName, i.ReceivedTime

        End If
    Next i
End Sub