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") & "'"
Related
I have a piece of code that is supposed to find all appointments in a shared calendar between two dates and delete them. However, it ignores the filter and deletes all appointments in the calendar. Could someone take a look at this and give me some idea of what i'm missing please?
Sub DeleteCal_Appts(sCalendarName As String, ap_dateStart As String, ap_startTime As String, ap_dateEnd As String, ap_endTime As String)
Dim objAppointment As AppointmentItem
Dim objAppointments As Items
Dim objNameSpace As Outlook.NameSpace
Dim objRecip As Recipient
Dim sFilter As Object
Dim dtStartTime As Date, dtEndTime As Date
dtStartTime = CDate(ap_dateStart & " " & ap_startTime)
dtEndTime = CDate(ap_dateEnd & " " & ap_endTime)
Dim myOutApp As Object
myOutApp = CreateObject("Outlook.Application")
objNameSpace = myOutApp.GetNamespace("MAPI")
objRecip = objNameSpace.CreateRecipient(sCalendarName)
objRecip.Resolve()
'objAppointments = objNameSpace.GetSharedDefaultFolder(objNameSpace.CreateRecipient("Unit 2 Peanut Delivery Calendar"), 9).Items
objAppointments = objNameSpace.GetSharedDefaultFolder(objNameSpace.CreateRecipient(sCalendarName), 9).Items
sFilter = "[Start] > '" & Format(dtStartTime, "ddddd h:nn AMPM") & "' And [Start] < '" & Format(dtEndTime, "ddddd h:nn AMPM") & "'"
objAppointments.Sort("[Start]", False)
MsgBox("Total Items at begin: " & objAppointments.Count)
objAppointment = objAppointments.Find(sFilter)
For i = objAppointments.Count To 1 Step -1
objAppointment = objAppointments.Item(i)
objAppointment.Delete()
Next
MsgBox("Total Items at finish: " & objAppointments.Count)
objAppointment = Nothing
objAppointments = Nothing
End Sub
Thanks to #TnTinMn got the answer to this. My only remaining stumbling block was for the date conversion from UK to US:
sFilter = "[Start] >= '" & (dtStartTime.ToString("MM/dd/yyyy HH:MM tt")) & "' AND [End] <= '" & (dtEndTime.ToString("MM/dd/yyyy HH:MM tt")) & "'"
objAppointments.Sort("[Start]", False)
itemsCalendar = objAppointments.Restrict(sFilter)
For i = itemsCalendar.Count To 1 Step -1
objAppointment = itemsCalendar.Item(i)
objAppointment.Delete()
Next
I prepared the tool, which is downloading email attachments based on user restrictions. Its working well, but when I was implementing it into new person from other dep I had a weird problem, becouse restrict functionality is not working at all. I provide the mailbox, the folder and with restrict details as below and it returns 0, when I checking each email thru loop its see all of them.
Set olApp = CreateObject("Outlook.Application")
Set olNamespace = olApp.GetNamespace("MAPI")
Set olMailboxFolder = olNamespace.Folders("FolderA").Folders("FolderB")
strRestriction = "[ReceivedTime] > '" & Format(myStartDate, "DDDDD HH:MM") & "' AND [ReceivedTime] < '" & Format(myEndDate, "DDDDD" & " 23:59") & "'"
Set olEmailFound = olMailboxFolder.Items.Restrict(strRestriction)
It could be something with outlook/folders setup? If code would be wrong it wont work anywhere, but its only one person...
You must use proper formatting of the date value string expressions:
Not working:
strRestriction = "[ReceivedTime] >= #" & Format(myStartDate, "yyyy\/mm\/dd hh\:nn") & "# AND [ReceivedTime] < #" & Format(DateAdd("d", 1, myEndDate), "yyyy\/mm\/dd") & "#"
Working:
Doc reference: Items.Restrict method (Outlook)
Although dates and times are typically stored with a Date format, the
Find and Restrict methods require that the date and time be converted
to a string representation. To make sure that the date is formatted as
Microsoft Outlook expects, use the Format function.
However, the documentation is buggy. The AM/PM part misses the slash:
sFilter = "[LastModificationTime] > '" & Format("1/15/99 3:30pm", "ddddd h:nn AMPM") & "'"
What seems to work in an International environment, is the predefined formats. Thus, this works with a Danish localisation:
Dim StartDate As String
Dim EndDate As String
Dim n As Integer
StartDate = Format(myStartDate, "Short Date") & " " & Format(myStartDate, "Short Time")
EndDate = Format(myEndDate, "Short Date") & " " & Format(myEndDate, "Short Time")
strRestriction = "[ReceivedTime] >= '" & StartDate & "' And [ReceivedTime] < '" & EndDate & "'"
Debug.Print strRestriction
Debug.Print olMailboxfolder.Items.Count
Set olEmailFound = olMailboxfolder.Items.Restrict(strRestriction)
For n = 1 To olEmailFound.Count
Debug.Print n, olEmailFound.Item(n).ReceivedTime
Next
Note, that if seconds is included in the formatted strings, the comparison will fail.
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
I'm trying to grab the last week of appointments using VBA in Outlook.
I'm using the .Restrict method, but something is making my string grab 3 years further back.
I start by declaring formatted dates for my time bracket:
myStart = Format(DateAdd("d", -7, Now()), "ddddd h:nn AMPM")
myEnd = Format(Now(), "ddddd h:nn AMPM")
I build a string to hold my restriction criterion.
strRestriction = "[Start] <= '" & myEnd _
& "' AND [End] >= '" & myStart & "'"
Finally I call restrict on my appointment items:
Set oRestrItems = oItems.Restrict(strRestriction)
For a little more context, here's how I use/call the result:
For Each oApptItem In oRestrItems 'oItems will grab everything, but that's hardly perfect.
If oApptItem.Sensitivity <> olPrivate Then
MsgBox (oApptItem.Subject)
MsgBox (oApptItem.Start)
MsgBox (oApptItem.End)
End If
Next
I can guess that you are missing two statements.
oItems.IncludeRecurrences = True
oItems.Sort "[Start]"
If this is the case, you can ask another question about why the Restrict requires these additional statements. Someone may have an answer.
Minimal, Complete, and Verifiable example. Try commenting out either or both statements. You should see that the items are not the same.
Option Explicit
Sub LastWeekAppts()
Dim objFolder As Folder
Dim oItems As items
Dim oRestrItems As items
Dim strRestriction As String
Dim myStart As Date
Dim myEnd As Date
Dim temp As Object
Set objFolder = Session.GetDefaultFolder(olFolderCalendar)
Set oItems = objFolder.items
' *****************************************
' Odd results without these two statements
oItems.IncludeRecurrences = True
oItems.Sort "[Start]"
' *****************************************
myEnd = Date
myStart = DateAdd("d", -7, Date)
Debug.Print " myStart: " & myStart
Debug.Print " myEnd : " & myEnd
strRestriction = "[Start] <= '" & myEnd _
& "' AND [End] >= '" & myStart & "'"
Debug.Print strRestriction
Set oRestrItems = oItems.Restrict(strRestriction)
For Each temp In oRestrItems
Debug.Print temp.start & " - " & temp.Subject
Next temp
End Sub
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