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
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
Subscribe to:
Posts (Atom)