Am trying to read mails that received only today. Below is the code where am restricting but its throwing an condition not valid error. The same is working fine when I gave a condition like unread = True.
Set myItems = myItems.Restrict("DateValue[ReceivedTime]='" & Format(DateValue(Now),"ddddd h:nn AMPM") & "'")
Please help me on this.
I see at least two problems.
You have "DateValue[ReceivedTime]" rather than "[ReceivedTime]".
You are restricting emails to those received at exactly midnight today rather than those received after midnight.
Try this code:
Sub RestrictByDate()
Dim FmtToday As String
Dim FldrInbox As Folder
Dim MailItemsToday As Items
Dim MailItemCrnt As MailItem
FmtToday = Format(DateValue(Now()), "ddddd h:nn AMPM")
' #### Replace "xxxx" with the name of the store containing the target Inbox
Set FldrInbox = Session.Folders("xxxx").Folders("Inbox")
Set MailItemsToday = FldrInbox.Items.Restrict("[ReceivedTime] > '" & FmtToday & "'")
Debug.Print "Number of emails received today=" & MailItemsToday.Count
For Each MailItemCrnt In MailItemsToday
With MailItemCrnt
Debug.Print .ReceivedTime & " " & .Subject
End With
Next
End Sub
Related
I often need a search for all emails of a specific day. In order not to change the criteria of a search folder every time, I wrote a macro which creates a suitable search folder after asking for a date and displaying this folder.
Works fine, but whereas the search folder created the manual way within Outlook only lists the mails of this day, the programmed version also displays appointments of calendars of colleagues who shared their calendars with me - appointments and meetings which don't relate to me at all but were sent on that specific day.
The second thing, but a not important one is, that when displaying the properties of the created folder in Outlook the button for changing the criteria is disabled.
I think I need some additional filter criteria for method AdvancedSearch, but which ones?
At the moment, my code is as follows:
Sub CreateSearchFolderForDate()
'Creates a search folder for a specific date. Only the primarey exchange mailbox will be considered
'(no offline folders, no shared folders).
'The folder is displayed afterwards
Dim oSearch As Search
Dim oSearchFolder As Object
Dim strScope As String
Dim strFilter As String
Dim strDate1 As String
Dim strDate2 As String
Dim strInput As String
varInput = InputBox("Date?", "Create search order for a specific date", Date)
If Not IsDate(varInput) Then
Exit Sub
End If
'Delete existing folder first, otherwise there is a runtime error
Set oSearchFolder = GetSearchFolderByName("Mails for day X")
If Not oSearchFolder Is Nothing Then
oSearchFolder.Delete
End If
strScope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).Parent.FolderPath & "'"
strFilter = "urn:schemas:mailheader:date >= '" & CDate(varInput) & "' AND urn:schemas:mailheader:date < '" & CDate(varInput) + 1 & "'"
Set oSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strFilter, SearchSubFolders:=True, Tag:="Mails of a specific date")
oSearch.Save ("Mails for day X")
Set oSearchFolder = GetSearchFolderByName("Mails for day X")
oSearchFolder.Display
End Sub
Function GetSearchFolderByName(strSearchFolderName As String) As Object
'Returns the search folder with the display name specified. Only the primarey exchange mailbox will be considered
'(no offline folders, no shared folders).
Dim oStore As Outlook.Store
Dim oFolder As Outlook.folder
On Error Resume Next
Set GetSearchFolderByName = Nothing
For Each oStore In Application.Session.Stores
If oStore.ExchangeStoreType = olPrimaryExchangeMailbox Then
For Each oFolder In oStore.GetSearchFolders
If oFolder.Name = strSearchFolderName Then
Set GetSearchFolderByName = oFolder
Exit Function
End If
Next
End If
Next
End Function
My idea was to use '''urn:schemas:calendar:dtstart'' as additional AND as for "normal" emails that should be empty and messed around a little bit with it - but either it had no effect or it resulted in a list containing only the undesired elements and no "normal" mails at all.
Attempts like IS NULL or IS NOT NULL in the filter caused VBA runtime errors.
In column "folder" the created search folder displays either the folder/subfolder my mails are stored in or for the unwanted entries a certain common part like Doe, Jane common_part and Doe, John common_part. But I didn't find a property which I could use as part of my filter ('''AND property NOT LIKE %common_part%''').
Any hint would be very much appreciated.
Regards,
Bootes
Update 2023-02-08: Before refactoring my problem using the hints and answers by #niton (thanks a lot for the patience) I will start a few more trys with AdvancedSearch, based on an analysis of a manually created search folder using the Redemption-Tool as developed by #Dmitry Streblechenko and described in his posting in How to get a search folder criteria in Outlook. The tool provided the following SQL-Statement:
((NOT (MessageClass LIKE 'IPM.Appointment%')) AND (NOT (MessageClass LIKE 'IPM.Contact%')) AND (NOT (MessageClass LIKE 'IPM.DistList%')) AND
(NOT (MessageClass LIKE 'IPM.Activity%')) AND
(NOT (MessageClass LIKE 'IPM.StickyNote%')) AND (NOT (MessageClass = 'IPM.Task'))
AND (NOT (MessageClass LIKE 'IPM.Task.%'))) AND
((("http://schemas.microsoft.com/mapi/proptag/0x0E090102" <> EF0000004B1E3AD5164F3F459BFE6A913D00E89042800000')
AND ("http://schemas.microsoft.com/mapi/proptag/0x0E090102" <> EF0000004B1E3AD5164F3F459BFE6A913D00E89022800000'))
AND ((SentOn < '2022-12-20') AND (SentOn >= '2022-12-19')))
I tried to translate this into VBA, but had no real success: If I use just the active lines, there is no effect at all, if I add the last two ones (formatted as comments below), I get error "Runtime error -2147023281 (8007064f) - Error during execution of operation" (re-translated from German to English):
strF = "urn:schemas:mailheader:date >= '" & CDate(strInput) & "' AND urn:schemas:mailheader:date < '" & CDate(strInput) + 1 & "' AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Appointment%') AND NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Contact%') AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.DistList%') AND NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Activity%') AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.StickyNote%') AND NOT (urn:schemas:mailheader:content-class = 'IPM.Task') AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Task.%')" ' AND "
'strF = strF & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0E090102" & Chr(34) & " <> 'EF0000004B1E3AD5164F3F459BFE6A913D00E89042800000'" ' AND "
'strF = strF & "(" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0E090102" & Chr(34) & " <> 'EF0000004B1E3AD5164F3F459BFE6A913D00E89022800000')) AND "
The second approach could be the folder of the item as the unwanted ones are listed in column "In folder" with the folder name containing the a common part that is not in the folder name of the wanted items.
You can limit the search to the inbox.
strScope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).folderPath & "'"
Advanced search is less capable than say .Restrict.
Delete items in Outlook by 'Type' or 'Message Class'
set restrictedItems = olSearchOlFolder.items.Restrict(" #SQL=""http://schemas.microsoft.com/mapi/proptag/0x001A001F"" LIKE 'IPM.Schedule.Meeting.%' ")
how to apply filter only on outlook messages using vba
oFilter2 = "[MessageClass] = 'IPM.Note'"
This is a theoretical implementation of "urn:schemas:mailheader:content-class", that may be applicable, from https://learn.microsoft.com/en-us/previous-versions/office/developer/exchange-server-2007/aa579702(v=exchg.80)
Private Sub AdvSearch_URN_Test()
Dim strSearch As String
Dim strDASLFilter As String
Dim strScope As String
Dim objSearch As Search
Dim strDASLFilter_option As String
Dim fldrNm As String
strScope = "'" & Session.GetDefaultFolder(olFolderInbox).Parent.folderPath & "'"
Debug.Print strScope
' https://learn.microsoft.com/en-us/previous-versions/office/developer/exchange-server-2007/aa579702(v=exchg.80)
' **** most options do nothing ****
' displayto & fromemail are functional
' search by displayto
strSearch = "to display name"
strDASLFilter_option = "displayto"
' These fail
'strDASLFilter_option = "sender" 'search by Sender
'strDASLFilter_option = "sendername" 'search by senderName
'strDASLFilter_option = "senderemail" 'search by SenderEmail
' search by content-class
' *** This fails ***
strSearch = "IPM.Note"
strDASLFilter_option = "content-class"
strDASLFilter = "urn:schemas:httpmail:" & strDASLFilter_option & " LIKE '%" & strSearch & "%'"
Debug.Print strDASLFilter
Set objSearch = AdvancedSearch(Scope:=strScope, filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")
'Save the search results to a searchfolder
fldrNm = strDASLFilter_option & " " & strSearch
Debug.Print fldrNm
objSearch.Save fldrNm
Debug.Print fldrNm & " saved."
End Sub
I have everything working to send an email via an Access command button. However, the displayed email address is incorrect.
Private Sub cmdSendEmail_Click()
Dim EmailApp, NameSpace, EmailSend As Object
Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.GetNamespace("MAPI")
Set EmailSend = EmailApp.CreateItem(0)
EmailSend.To = [emailadd] '[emailadd] is the field on the form where the button is located
EmailSend.Subject = [Forms]![WorkordersVR]![Project] & " - " & [Forms]![WorkordersVR]![JobNumber]
EmailSend.Body = "Hello," & vbCrLf & vbCrLf & _
"The project" & " " & [Forms]![WorkordersVR]![Project] & " " & "is ready for pickup." & vbCrLf & vbCrLf & _
"Thank you!" & vbCrLf & vbCrLf & _
"Person sending email here" & vbCrLf & _
EmailSend.Display
Set EmailApp = Nothing
Set NameSpace = Nothing
Set EmailSend = Nothing
End Sub
What ends up in the displayed email To is:
"fred#aplace.com#fred#aplace.com#"
How do I get fred#aplace.com?
You can use string functions available in VBA to get a substring until the # symbol in the string. For example, the InStr function returns a number specifying the position of the first occurrence of one string within another.
Also I'd suggest using the Recipients property of the MailItem class which returns a Recipients collection that represents all the recipients for the Outlook item. Then I'd suggest using the Recipient.Resolve method which attempts to resolve a Recipient object against the Address Book.
For example:
Sub CreateStatusReportToBoss()
Dim myItem As Outlook.MailItem
Dim myRecipient As Outlook.Recipient
Set myItem = Application.CreateItem(olMailItem)
Set myRecipient = myItem.Recipients.Add("email")
myRecipient.Resolve
If(myRecipient.Resolved) Then
myItem.Subject = "Status Report"
myItem.Display
End If
End Sub
I've written some code that scans my default Outlook inbox for emails received today with a specific subject.
I then download the attachment for Outlook items that meet my criteria. I am having trouble designating the Restrict method to pull back items received today.
Here is what I have:
Sub DownloadAttachmentFirstUnreadEmail()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
Dim sFilter As String
Dim NewFileName As String
NewFileName = "C:\Temp\" & "CHG_Daily_Extract_" & Format(Date, "MM-DD-YYYY") & ".csv"
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'Declare email item restriction
sFilter = "[ReceivedTime] = '" & Format(Date, "DDDDD HH:NN") & "'"
'Catch
If oOlInb.Items.Restrict(sFilter).Count > 0 Then
'~~> Loop thru today's emails
For Each oOlItm In oOlInb.Items.Restrict(sFilter)
'~> Check if the email subject matches
If oOlItm = "ASG CDAS Daily CHG Report" Then
'~~> Download the attachment
For Each oOlAtch In oOlItm.Attachments
oOlAtch.SaveAsFile NewFileName
Exit For
Next
End If
Exit For
Next
'Display if no emails today
Else: MsgBox "No items"
End If
End Sub
When I run the code, I consistently receive my catch message of "No items".
Please let me know if I am using the Restrict method incorrectly. Thank you so much for the help.
How about the following-
Filter = "#SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
Chr(34) & ")%
Or with Attachment
Filter = "#SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
Chr(34) & ")% AND " & _
Chr(34) & "urn:schemas:httpmail:hasattachment" & _
Chr(34) & "=1"
Example
Option Explicit
Private Sub Examples()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim Msg As String
Dim i As Long
Dim Filter As String
Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Filter = "#SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
Chr(34) & ")%"
Set Items = Inbox.Items.Restrict(Filter)
Msg = Items.Count & " Items in " & Inbox.Name
If MsgBox(Msg, vbYesNo) = vbYes Then
For i = Items.Count To 1 Step -1
Debug.Print Items(i) 'Immediate Window
Next
End If
End Sub
Filtering Items Using a Date-time Comparison MSDN
Outlook Date-time Macros
The date macros listed below return filter strings that compare the value of a given date-time property with a specified date in UTC; SchemaName is any valid date-time property referenced by namespace.
Note Outlook date-time macros can be used only in DASL queries.
Macro Syntax Description
today %today(" SchemaName")% Restricts for items with SchemaName
property value equal to today
More Examples Here
I have an Outlook macro that filters email objects by date and returns items based on an array.
The filter for today is the following:
sfilter = "[ReceivedTime]>=""&Date()12:00am&"""
Set myItems = myNewFolder.Items.Restrict(sfilter)
sFilter is a string and this returns the items for today as intended.
I am trying to filter to emails received yesterday.
The following were my attempts.
sfilter = "[ReceivedTime]>=""&Date(-1) 12:00am&"" AND [ReceivedTime]<= ""&Date() 12:00am&"" "
tfilter = Format(DateAdd("d", -1, Date), "mm/dd/yyyy")
rFilter = Format(DateAdd("d", 0, Date), "mm/dd/yyyy")
I intended to use the tFilter and rFilter as the upper and lower bound for sFilter.
I tried to use the DateAdd method after looking on the MSDN site with the function information but that did not return yesterday's items.
I tried the solution offered on this question (Outlook .Restrict method does not work with Date).
The method with date(-1) did not work in tandem with date. According to the MSDN site logical operators should work.
Note: The lower three examples cited compile and do not return any errors.
You can find yesterday's mail with two separate Restricts.
Private Sub EmailYesterday()
Dim oOlInb As Folder
Dim oOlItm As Object
Dim oOlResults As Object
Dim i As Long
Dim sFilter As String
Dim sFilter2 As String
Set oOlInb = Session.GetDefaultFolder(olFolderInbox)
'Filter recent - Lower Bound of the range
sFilter = "[ReceivedTime]>'" & format(Date - 1, "DDDDD HH:NN") & "'"
Debug.Print vbCr & sFilter
Set oOlResults = oOlInb.Items.Restrict(sFilter)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.Subject & " - " & oOlItm.ReceivedTime
Next i
End If
' Filter range - Upper Bound
sFilter2 = "[ReceivedTime]<'" & format(Date, "DDDDD HH:NN") & "'"
Debug.Print vbCr & sFilter; " AND " & sFilter2
Set oOlResults = oOlResults.Restrict(sFilter2) ' Restrict the Lower Bound result
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.Subject & " - " & oOlItm.ReceivedTime
Next i
End If
ExitRoutine:
Set oOlInb = Nothing
Set oOlResults = Nothing
Debug.Print "Done."
End Sub
Yesterday date could be filtered as below
oOlResults.Restrict("#SQL=%yesterday(""urn:schemas:httpmail:datereceived"")%")
The same for today or this month.
oOlResults.Restrict("#SQL=%today(""urn:schemas:httpmail:datereceived"")%")
oOlResults.Restrict("#SQL=%thismonth(""urn:schemas:httpmail:datereceived"")%")
More info here
I'm trying from Excel to scan a shared inbox for emails with attachments, which were received on a certain date. The aim is to save the attachments and import them into the workbook running the code.
Here's the code I have so far adapted from Download attachment from Outlook and Open in Excel to scan the inbox and print some info on the emails it finds
Sub extractEmailDetails()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object, oOlInp As Object
Dim oOlItm As Object
Dim strDateFrom As String, strDateTo As String
Dim searchDate As Date
searchDate = #12/9/2015# 'mm/dd/yyyy
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy") & "'"
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInp = oOlns.Folders("SHR-Cust Ops MI Team Inbox")
Set oOlInb = oOlInp.Folders("Inbox")
'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items.Restrict("[attachment] = True AND [receivedTime] > " & strDateFrom & " AND [receivedTime] < " & strDateTo)
Debug.Print oOlItm.ReceivedTime & " " & oOlItm.Subject
Next
End Sub
When I search for the 8th of December it only brings back emails that were received after 8am.
I changed the settings for working hours in the calendar to midnight to midnight (no working hours) and the code then brought back all emails for the specified date. However, I can't leave my calendar with no working hours. Is there a way to change the default behaviour to ignore the working hours?
It sure sounds like your are getting GMT + your local time zone offset.
What is your TZ?
After messing around with this a little I've found a solution. A very obvious one. You can't just provide the date, you also need to provide a time, so:
[...]
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy") & "'"
Becomes
[...]
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy hh:mm") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy hh:mm") & "'"