I simply want to select all mail in my inbox that contain (in Body) a certain string. I thought Find would be a good Approach. Rather to make a for..each on all items in inbox...
However my command does (see below) not work. It brings "invalid condition"
Set Msg = Inbox.Items.Find("abc")
2 Questions:
1. How to fill in the desired condition?
2. What is result of that find? A single email or a collection I need to put in a variant or so
The Find method locates and returns a Microsoft Outlook item object that satisfies the given Filter. See Filtering Items Using Query Keywords for more information about possible query strings. After the Find method runs, the FindNext method finds and returns the next Outlook item in the specified collection. For example:
Sub DemoFindNext()
Dim myNameSpace As Outlook.NameSpace
Dim tdystart As Date
Dim tdyend As Date
Dim myAppointments As Outlook.Items
Dim currentAppointment As Outlook.AppointmentItem
Set myNameSpace = Application.GetNamespace("MAPI")
tdystart = VBA.Format(Now, "Short Date")
tdyend = VBA.Format(Now + 1, "Short Date")
Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
While TypeName(currentAppointment) <> "Nothing"
MsgBox currentAppointment.Subject
Set currentAppointment = myAppointments.FindNext
Wend
End Sub
Related
As the title suggests, is it possible to have a script pickup all todays outlook calendar appointments and exports them into excel to a specific location
And this would happen every day automatically
This Macro gets all appoitments for the current day and writes it to an excel File:
Needs to be run from Outlook-VBA.
Sub FindAppointments()
Dim myNameSpace As Outlook.NameSpace
Dim tdystart As Date
Dim tdyend As Date
Dim myAppointments As Outlook.Items
Dim currentAppointment As Outlook.AppointmentItem
Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlWorksheet As Object
Dim i As Long
Set xlApp = CreateObject("Excel.Application")
Set xlWorkbook = xlApp.Workbooks.Add
Set xlWorksheet = xlWorkbook.Worksheets(1)
With xlWorksheet
.Cells(1, 1).Value = "Subject"
.Cells(1, 2).Value = "Body"
.Cells(1, 3).Value = "Start"
.Cells(1, 4).Value = "End"
End With
Set myNameSpace = Application.GetNamespace("MAPI")
tdystart = VBA.Format(Now, "Short Date")
tdyend = VBA.Format(Now + 1, "Short Date")
Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
myAppointments.Sort "[Start]"
myAppointments.IncludeRecurrences = True
Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
i = 2
While TypeName(currentAppointment) <> "Nothing"
Debug.Print currentAppointment.Subject
xlWorksheet.Cells(i, 1).Value = currentAppointment.Subject
xlWorksheet.Cells(i, 2).Value = currentAppointment.Body
xlWorksheet.Cells(i, 3).Value = currentAppointment.Start
xlWorksheet.Cells(i, 4).Value = currentAppointment.End
i = i + 1
Set currentAppointment = myAppointments.FindNext
Wend
xlWorksheet.Columns("A:D").EntireColumn.AutoFit
xlWorkbook.SaveAs "C:\temp\test.xlsx" ' <------- Change this Path to the location you want to save the file to
xlWorkbook.Close
End Sub
Yes, it is possible to develop a VBA macro where you can get all appointment for a specific date and export them to an Excel spreadsheet. But Outlook doesn't provide anything for running your script on a daily basis, the code can be run only when Outlook is launched. So, you can run your code when Outlook is launched and create a timer for any further launches. By the timer tick event you may check whether the current day data was already exported or not. You may find the Outlook VBA - Run a code every half an hour thread helpful.
To get the appointment for a specific date you need to use the Find/FindNext or Restrict methods of the Items class. You can read more about these methods in the following articles:
How To: Retrieve Outlook calendar items using Find and FindNext methods
How To: Use Restrict method in Outlook to get calendar items
I receive emails and would like to save size of attachment in Excel sheet.
I can save size of email but I can't get size of attachment.
I looked up attachment.Size Property in MSDN, but it doesn't work. Could you please take a loop my for loop? I've attached my code below. I appreciate it if anyone would help.
Sub GetFromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim OutlookMail As Variant
Dim Folder As MAPIFolder
Dim olItems As Outlook.Items
Dim myItems As Outlook.Items
Dim olShareName As Outlook.Recipient
Dim dStart As Date
Dim dEnd As Date
Dim i As Integer
Dim sFilter As String
Dim sFilterLower As String
Dim sFilterUpper As String
Dim sFilterSender As String
'========================================================
'access to shared mailbox to get items
'========================================================
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set olShareName = OutlookNamespace.CreateRecipient("teammailbox#example.ca")
Set Folder = Session.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders("Subfolder1").Folders("Subfolder2")
Set olItems = Folder.Items
dStart = Range("From_Date").Value
dEnd = Range("To_Date").Value
'========================================================
'Conditions for restrict to get items specificed date
'========================================================
sFilterLower = "[ReceivedTime] > '" & Format(dStart, "ddddd h:nn AMPM") & "'"
sFilterUpper = "[ReceivedTime] < '" & Format(dEnd, "ddddd h:nn AMPM") & "'"
sFilterSender = "[SenderName] = ""jon.doe#example.com"""
'========================================================
'Restrict emails followed by above conditions
'========================================================
Set myItems = olItems.Restrict(sFilterLower)
Set myItems = myItems.Restrict(sFilterUpper)
Set myItems = myItems.Restrict(sFilterSender)
'========================================================
'items(emails) display in worksheets
'========================================================
i = 1
For Each myItem In myItems
MsgBox myItem.Attachments.Size
Range("eMail_subject").Offset(i, 0).Value = myItem.Subject
Range("eMail_date").Offset(i, 0).Value = Format(myItem.ReceivedTime, "h:nn")
Range("eMail_size").Offset(i, 0).Value = myItem.Size
i = i + 1
Next myItem
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
End Sub
Sub sbClearCellsOnlyData()
Rows("5:" & Rows.Count).ClearContents
End Sub
The VBEditor has a great built-in tool for debugging. If you press Ctrl+F9, while selecting the myItem text with your mouse cursor you would be able to see it. It is called "Local Window" (or in German - "überwachungsausdrücke")
Long stroy short, give it a try like this in the code:
MsgBox myItem.Attachments.Item(1).Size
Instead of:
MsgBox myItem.Attachments.Size
Before doing this, it is a good idea to see whether the attachment exists:
If myItem.Attachments.Count > 0 Then
Attachment.Size property is not the size of the file blob - it is the size of the attachment record in the message store, which includes the attachment data, file name, and various other MAPI properties.
If you only want the file data, you can either use Extended MAPI (C++ or Delphi) to open the blob (PR_ATTACH_DATA_BIN) as IStream and call IStream::Stat. If you are limited to using the Outlook Object Model only, the only workaround is saving the attachment as file (Attachment.SaveAsFile) and then retrieving the file size.
I got hint from #Vityata and my below code is fixed and it works now.
For Each myItem In myItems
Range("eMail_subject").Offset(i, 0).Value = myItem.Subject
Range("eMail_date").Offset(i, 0).Value = Format(myItem.ReceivedTime, "h:nn")
If myItem.Attachments.Count > 0 Then
Range("eMail_size").Offset(i, 0).Value = myItem.Attachments.Item(1).Size / 1024 'convert to 3 digits (KB)
Else
Range("eMail_size").Offset(i, 0).Value = "No attached file"
End If
i = i + 1
Next myItem
I have the below code which works.
I now need to find the newest email with that subject line and open it.
Once the email is opened, I'd like to save the attachment to my desktop and close out of the opened email.
Sub SearchOL()
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
i = 1
For Each olMail In Fldr.Items
If InStr(olMail.Subject, "DNP Warn and Pend Event") <> 0 Then
olMail.Display
i = i + 1
End If
Next olMail
End Sub
I'd suggest starting from the Getting Started with VBA in Outlook 2010 article in MSDN.
Use the Find/FindNext or Restrict methods of the Items class to find the emails with a particular subject line instead of iterating through each email and checking the subject line.
Sub DemoFindNext()
Dim myNameSpace As Outlook.NameSpace
Dim tdystart As Date
Dim tdyend As Date
Dim myAppointments As Outlook.Items
Dim currentAppointment As Outlook.AppointmentItem
Set myNameSpace = Application.GetNamespace("MAPI")
tdystart = VBA.Format(Now, "Short Date")
tdyend = VBA.Format(Now + 1, "Short Date")
Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
While TypeName(currentAppointment) <> "Nothing"
MsgBox currentAppointment.Subject
Set currentAppointment = myAppointments.FindNext
Wend
End Sub
I need to check items in a folder in a specific time frame.
My code goes through all the mails in the specified folder, but the folder has thousands of mails, so it takes forever.
How do I check the mails only from, for example, 3/16/2015 12:00PM to 3/16/2015 2:00PM?
This is what I have:
Sub ExportToExcel()
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim workbookFile As String
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
'Folder path and file name of an existing Excel workbook
workbookFile = "C:\Users\OutlookItems.xls"
'Select export folder
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
'Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
End If
' Open and activate Excel workbook.
Set appExcel = CreateObject("Excel.Application")
Set wkb = appExcel.Workbooks.Open(workbookFile)
Set wks = wkb.Sheets(1)
wks.Activate
appExcel.Application.Visible = True
Set rng = wks.Range("A1")
'Copy field items in mail folder.
For Each itm In fld.Items
If itm.Class = Outlook.OlObjectClass.olMail Then
Set msg = itm
If InStr(msg.Subject, "Error in WU_Send") > 0 And DateDiff("h", msg.SentOn, Now) <= 2 Then
rng.Offset(0, 4).Value = msg.Body
Set rng = rng.Offset(1, 0)
End If
End If
Next
End Sub
The problem lies in this part:
For Each itm In fld.Items
If itm.Class = Outlook.OlObjectClass.olMail Then
Set msg = itm
If InStr(msg.Subject, "Error in WU_Send") > 0 And DateDiff("h", msg.SentOn, Now) <= 2 Then
How do I look at e-mails between specified hours?
You need to use the Find/FindNext or Restrict methods of the Items class instead of iterating through all items in the folder. For example:
Sub DemoFindNext()
Dim myNameSpace As Outlook.NameSpace
Dim tdystart As Date
Dim tdyend As Date
Dim myAppointments As Outlook.Items
Dim currentAppointment As Outlook.AppointmentItem
Set myNameSpace = Application.GetNamespace("MAPI")
tdystart = VBA.Format(Now, "Short Date")
tdyend = VBA.Format(Now + 1, "Short Date")
Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
While TypeName(currentAppointment) <> "Nothing"
MsgBox currentAppointment.Subject
Set currentAppointment = myAppointments.FindNext
Wend
End Sub
See the following articles for more information and sample code:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
Also you may find the AdvancedSearch method of the Application class helpful. The key benefits of using the AdvancedSearch method are listed below:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). You can read more about this in the Filtering article in MSDN. To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.
You could just change the line to:
If InStr(msg.Subject, "Error in WU_Send") > 0 And msg.SentOn > "03/16/2015 12:00 PM" AND msg.SentOn < "03/16/2015 2:00 PM" Then
This specifies the time period.
Option Explicit
Sub RestrictTimePeriod()
Dim nms As Namespace
Dim fld As folder ' Subsequent to 2003 otherwise MAPIFolder
Dim msg As MailItem
Dim filterCriteria As String
Dim filterItems As Items
Dim i As Long
Dim start
Dim dif
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
If Not fld Is Nothing Then
start = Now
Debug.Print start
' http://www.jpsoftwaretech.com/use-filters-to-speed-up-outlook-macros/
filterCriteria = "[ReceivedTime] > " & QuoteWrap("2015-03-16 12:00 PM") & _
" And [ReceivedTime] < " & QuoteWrap("2015-03-17 2:00 PM")
Set filterItems = fld.Items.Restrict(filterCriteria)
For i = filterItems.count To 1 Step -1
Set msg = filterItems.Item(i)
Debug.Print msg.Subject
Next
End If
ExitRoutine:
Set nms = Nothing
Set msg = Nothing
Set filterItems = Nothing
Debug.Print Now
dif = (Now - start) * 86400
Debug.Print dif
Debug.Print "Done."
End Sub
Function QuoteWrap(stringToWrap As String, _
Optional charToUse As Long = 39) As String
' http://www.jpsoftwaretech.com/use-filters-to-speed-up-outlook-macros/
' use 34 for double quotes, 39 for apostrophe
QuoteWrap = Chr(charToUse) & stringToWrap & Chr(charToUse)
End Function
I'm trying to find an appointment on or after a specific date (for this program today was chosen) in the current session of a single workstation.
I then want to extract the Subject line from the appointment and the Description and display them in a message box (for future error checking).
If possible I also want to count how many appointments are in a single day.
I'm having trouble setting the object as well as binding "i" to the correct item in Outlook's array. I say "Outlook's array" because in the base code I have oItems.Item(i) where i is an Item from some appointment in my calender at the designated number.
Maybe it would be better to use something else besides Item?
Or better yet find an item's location in the array that is relevant to the date that I'm restricting the search to?
Below is the old code before Dmitry's link.
Private Sub FindAppt()
Dim oItems As Items
Dim oItemOriginal As AppointmentItem
Dim Subject As String
Dim Descript As String
Set oItems = Outlook.Application.Session.GetDefaultFolder(olFolderCalendar).Items
If oItems >= Format(Date, "mmmm dd yyyy") Then
Set oItemOriginal = oItems.Item(i)
End If
With oItemOriginal
Subject = .Subject
Descript = .FormDescription
End With
MsgBox (Subject & Description)
End Sub
New code. With the new approach should I be breaking up these array binding and array extraction pieces into separate "Subs"?
Sub FindAppt()
Dim myNameSpace As Outlook.NameSpace
Dim tdystart As Date
Dim tdyend As Date
Dim myAppointments As Outlook.Items
Dim currentAppointment As Outlook.AppointmentItem
Dim SubjectArray(50) As Variant
Dim i As Integer
Dim DescArray(50) As Variant
Dim Excl As Excel.Application
Set myNameSpace = Application.GetNamespace("MAPI")
'This line is Bonus, if you're just looking to start your search for today's_
date.
tdystart = VBA.Format(Now, "Short Date")
'This input works which means a user form with combo boxes will work or user input_
will work as long as user input conforms to VBA date formats.
'tdystart = "04/01/2014"
'This line is Bonus, if you're just looking for the day after and after_
appointments.
tdyend = VBA.Format(Now + 1, "Short Date")
'tdyend = VBA.Format(tdystart + 5, "Short Date")
Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
myAppointments.Sort "[Start]"
myAppointments.IncludeRecurrences = True
Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
While TypeName(currentAppointment) <> "Nothing"
MsgBox currentAppointment.Subject & " " & currentAppointment.FormDescription
While currentAppointment = True
For i = 0 To 50
SubjectArray(i) = currentAppointment.Subject
DescArray(i) = currentAppointment.FormDescription
ReDim Preserve SubjectArray(1 To Count + 1)
ReDim Preserve DescArray(1 To Count + 1)
Next i
Wend
Set currentAppointment = myAppointments.FindNext
Wend
End Sub
Private Sub Timecard()
Set Excl = Excel.Application
Dim i As Integer
Dim SubjectArray(byRef 50, byValue) As Variant
Dim DecArray (byRef,byvalue)
With Excl
.fPath = ("C:\FilePathName\Book1.xlsx")
Excl.Open
End With
For i = 0 To 50
Excl.Application.Activesheet.Range(i, 0) = SubjectArray(i)
Excl.Application.Activesheet.Range(i, 1) = DecArray(i)
Next
End Property
End Sub
I am not sure what the line "If oItems >= Format(Date, "mmmm dd yyyy") Then" is supposed to do: you are comparing an Items object with a string.
See http://msdn.microsoft.com/en-us/library/office/ff866969(v=office.15).aspx for an example on how to retrieve items in a particular time range.