Sub movemailtoafolder_working()
Dim olApp, mail As Object
Set olApp = CreateObject("Outlook.Application")
Dim olFolder As Outlook.MAPIFolder
Dim olmailitem As Outlook.MailItem
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")
'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
MsgBox (olFolder.Items.Restrict(datetocheck).count)
For i = olFolder.Items.Restrict(datetocheck).count To 1 Step -1
' If the email is an Outlook email
If olFolder.Items.Restrict(datetocheck).Item(i).Class = 43 Then
'Debug.Print i.Subject, i.SenderName, i.ReceivedTime
olFolder.Items.Restrict(datetocheck).Item(i).Move olFolder.Folders("test")
End If
Next i
End Sub
Friday, September 24, 2021
Move filtered mails from a folder by date range to a different folder in a different way in outlook using vba
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment