I need to search the inbox, sent, draft, & outbox, for the latest message containing a particular Subject line & reply all. (Trying to continue the threads of specific emails.)
Posted on other sites, however I have not received any actionable advice.
The Outlook object model provides the Find/FindNext or Restrict methods of the Items class to search for items in a single folder. But the most powerful and reliable search is using the AdvancedSearch method of the Application class.
The key benefits of using the AdvancedSearch method in Outlook are:
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.
One of your links leads to the code you are interested in:
Option Explicit
' Event handler for outlook
Dim WithEvents OutlookApp As Outlook.Application
Dim outlookSearch As Outlook.Search
Dim outlookResults As Outlook.Results
Dim searchComplete As Boolean
' Handler for Advanced search complete
Private Sub outlookApp_AdvancedSearchComplete(ByVal SearchObject As Search)
'MsgBox "The AdvancedSearchComplete Event fired."
searchComplete = True
End Sub
Sub SearchAndReply(emailSubject As String, searchFolderName As String, searchSubFolders As Boolean)
' Declare objects variables
Dim customMailItem As Outlook.MailItem
Dim searchString As String
Dim resultItem As Integer
' Variable defined at the class level
Set OutlookApp = New Outlook.Application
' Variable defined at the class level (modified by outlookApp_AdvancedSearchComplete when search is completed)
searchComplete = False
' You can look up on the internet for urn:schemas strings to make custom searches
searchString = "urn:schemas:httpmail:subject like '" & emailSubject & "'" ' Use: subject like '%" & emailSubject & "%'" if you want to include words see %
' Perform advanced search
Set outlookSearch = OutlookApp.AdvancedSearch(searchFolderName, searchString, searchSubFolders, "SearchTag")
' Wait until search is complete based on outlookApp_AdvancedSearchComplete event
While searchComplete = False
DoEvents
Wend
' Get the results
Set outlookResults = outlookSearch.Results
If outlookResults.Count = 0 Then Exit Sub
' Sort descending so you get the latest
outlookResults.Sort "[SentOn]", True
' Reply only to the latest one
resultItem = 1
' Some properties you can check from the email item for debugging purposes
On Error Resume Next
Debug.Print outlookResults.Item(resultItem).SentOn, outlookResults.Item(resultItem).ReceivedTime, outlookResults.Item(resultItem).SenderName, outlookResults.Item(resultItem).Subject
On Error GoTo 0
Set customMailItem = outlookResults.Item(resultItem).ReplyAll
' At least one reply setting is required in order to replyall to fire
customMailItem.Body = "Just a reply text " & customMailItem.Body
customMailItem.Display
End Sub
You may find the Getting started with VBA in Office article helpful.
Related
I can capture a collection of items to a variable by Items.Restrict or a Search Object by AdvancedSearch ... how do I display the Items or Search in the ActiveExplorer??
Where objSearch is a Search Object
Set objSearch = objOL.AdvancedSearch(strScope, strSearch, True, "PracticeSearch")
Or where rtrndItems is an Items Object
Set rtrndItems = myItems.Restrict(strSearch)
Thanks for any help!!
All these methods are designed to be run programmatically without any UI feedback. The best what you could do is to save the AdvancedSearch results into a search folder in Outlook. The Search.Save method saves the search results to a Search Folder. For example:
Public blnSearchComp As Boolean
Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)
MsgBox "The AdvancedSearchComplete Event fired"
blnSearchComp = True
End Sub
Sub TestAdvancedSearchComplete()
Dim sch As Outlook.Search
Dim rsts As Outlook.Results
Dim i As Integer
blnSearchComp = False
Const strF As String = "urn:schemas:mailheader:subject = 'Test'"
Const strS As String = "Inbox"
Set sch = Application.AdvancedSearch(strS, strF)
While blnSearchComp = False
DoEvents
Wend
sch.Save("Subject Test")
End Sub
To search items in Outlook with any UI feedback involved you need to use the Explorer.Search method which performs a Microsoft Instant Search on the current folder displayed in the Explorer using the given Query
Here is what MSDN states for the Search method:
The functionality of Explorer.Search is analogous to the Search button in Instant Search. It behaves as if the user has typed the query string in the Instant Search user interface and then clicked Search. When calling Search, the query is run in the user interface, and there is no programmatic mechanism to obtain the search results. For more information on Instant Search, query for "Instant Search" in the Outlook Help.
The Search method does not provide a callback to enable the developer to determine when the search is complete.
Every day I get one or more spam emails of a very specific type to my xxxxx#gmail account.
They all have a garbled and unique FROM: email address.
The TO: and CC: fields are always of the form xxxxx[random chars]#aol.com. For example I got one today with
TO: xxxxx#aol.com
CC: xxxxxY7#aol.com
I would like to create a rule to automatically send these to spam and block. Two possible conditionals would be:
"with xxxxx AND #aol.com in recipient's address"
"with xxxxx*#aol.com in recipient's address" (with * as a wildcard).
#1 doesnt work because the "specific words" it requests are concatenated with OR, no option to use AND.
#2 doesn't work because as far as I can tell there is no way to use wildcards.
Any suggestions? I realize there probably is a straightforward VBA script solution but I haven't played with VBA in over a decade. Was hoping there might be another clever non-VBA work around. Thanks.
There is no workaround. You can handle incoming emails in Outlook VBA by handling the NewMailEx event of the Application class. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example, MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item. You can use the Entry ID from the EntryIDCollection parameter to call the NameSpace.GetItemFromID method and process the item.
In the NewMailEx event handler you can check the required properties such as Recipients and etc. and move the item wherever you need.
As stated, NewMailEx can be used to handle some filtering like this and I have a regex filter that I use as standard automatic rules don't allow that (or at least not currently - maybe a future upgrade). If you can use a regex to identify the e-mails you want to process then you could use this code:
In ThisOutlookSession
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
On Error Resume Next
Call RegExFilterRules(EntryIDCollection)
End Sub
In a module
Sub RegExFilterRules(ItemID As String)
With Application.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder: Set Inbox = .GetDefaultFolder(olFolderInbox)
Dim Junk As Outlook.MAPIFolder: Set Junk = .GetDefaultFolder(olFolderJunk)
Dim olItem As Outlook.MailItem: Set olItem = .GetItemFromID(ItemID, Inbox.StoreID)
End With
'On Error Resume Next
If Not olItem Is Nothing And olItem.Class = olMail Then
If IsPatternFound(olItem.subject, "^M\d+$") Then olItem.Move Junk 'olItem.Delete 'olItem.UnRead = False
If olItem.Sender = "cortana#microsoft.com" Then olItem.Delete
End If
Set olItem = Nothing
End Sub
Private Function IsPatternFound(Content As String, Pattern As String) As Boolean
' Requires Reference: Microsoft Scripting Runtime
Dim RegEx As Object: Set RegEx = CreateObject("vbscript.RegExp")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = Pattern
IsPatternFound = .Test(Content)
End With
End Function
I have Outlook 2016 on my computer at work and the "Run a Script" rule has been disabled. I'm aware of the changes that should be made in the regedit file, but I need admin access to do so. My IT team is located across the country from me, so I've been waiting for two weeks for them to change this and I'm convinced that it's never going to happen.
So, I'm wondering if there's a workaround or a way to code the same process?
When I receive an e-mail with certain words in the subject line, I would like the rule/script to save the file attachment (inside the e-mail) into a folder on my computer.
I'm no VBA expert at all (especially with Outlook), so I'm probably far away from being on the right path, but I've given it a shot:
Private Sub Application_Startup()
Dim oRule as Outlook.Rule
Dim oRuleAction as Outlook.RuleAction
Dim oRuleCondition as Outlook.RuleCondition
Set oRule = colRules.Create("Transfer Attachment", olRuleSubject)
Set oRuleCondition = oRule.Conditions.Subject("FINAL-CPW GRP SALES")
Set oRuleAction = SaveAtlasReport
End Sub
Public Sub SaveAtlasReport()
Dim att as Attachment
Dim FileName as string
FileName = "C:\Users\WCD1867\Documents\AttachTest\PositivePOS.xlsx"
att.SaveAsFile FileName
End Sub
Replace your "Outlook Rule / Run a Script" with Items.ItemAdd Event (Outlook) and Items.Restrict Method (Outlook) to Filter Items by subject line.
Example
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim Filter As String
Filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & _
Chr(34) & " Like '%FINAL-CPW GRP SALES%' AND " & _
Chr(34) & "urn:schemas:httpmail:hasattachment" & _
Chr(34) & "=1"
Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Set Items = Inbox.Items.Restrict(Filter)
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.mailitem Then
Dim AtmtName As String
Dim FilePath As String
FilePath = "C:\Temp\"
Dim Atmt As Attachment
For Each Atmt In Item.Attachments
AtmtName = FilePath & Atmt.FileName
Debug.Print AtmtName ' Print on Immediate Window
Atmt.SaveAsFile AtmtName
Next
End If
End Sub
Items.ItemAdd Event (Outlook) Occurs when one or more items are added to the specified collection. This event does not run when a large number of items are added to the folder at once. This event is not available in Microsoft Visual Basic Scripting Edition (VBScript).
Items.Restrict method is an alternative to using the Find method or FindNext method to iterate over specific items within a collection. The Find or FindNext methods are faster than filtering if there are a small number of items. The Restrict method is significantly faster if there is a large number of items in the collection, especially if only a few items in a large collection are expected to be found.
Filtering Items Using a String Comparison that DASL filters support includes equivalence, prefix, phrase, and substring matching. Note that when you filter on the Subject property, prefixes such as "RE: " and "FW: " are ignored.
For those who wanna edit reg see https://stackoverflow.com/a/48778903/4539709
By definition you can't run a script when running scripts are disabled. If you could then hackers around the globe would rejoice and people would have to stop using Outlook for corporate mail.
There is no built-in function to do what you want.
It can be done with plugins, like Kutools:
https://www.extendoffice.com/product/kutools-for-outlook.html
Your IT dept may not want to let you do this for security reasons. You should not seek to circumvent rules that you don't understand the implications of.
I need to create custom filters in Outlook to save me from having to manually adjust the filter setting each time, preferably with VBA.
Below is my attempt. I inserted the message box line to check the correct items are being restricted. On running the macro I get a number of message boxes displayed with "1" indicating to me that it is working as expected (message box appears for each 'In Progress' item).
For Each Task_List In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items.Restrict("[Status]='In Progress'")
MsgBox Task_List.Status
sFilter = "[Status]=Task_List.Status"
Next
However, the tasks in the task folder are not filtered, all the tasks are displayed regardless of criteria.
What am I missing from my code? Or am I completely barking up the wrong tree.
Thanks, and apologies in advance for the simplistic question.
Once you manually set up different views you can get to them this way.
Where the view is named for instance "In Progress"
Sub TaskView_InProgress()
' No error if the view does not exist
' No error if not currently in Tasks folder
ActiveExplorer.CurrentView = "In Progress"
End Sub
This demonstrates how to access the In Progress tasks. Albeit much less helpful than a view if you have many tasks.
Private Sub task_Filter()
' Folders may contain any type of item
Dim myItem As Object
Dim myItems As items
Dim resItems As items
Dim myTaskFolder As Folder
Dim sFilter As String
Dim msgPrompt As String
Set myTaskFolder = Session.GetDefaultFolder(olFolderTasks)
Set myItems = myTaskFolder.items
sFilter = "[Status]='In Progress'"
Set resItems = myItems.Restrict(sFilter)
For Each myItem In resItems
If myItem.Class = OlTask Then
myItem.Display
End If
Next
End Sub
This sub worked great for my purpose. I wanted to also input a string in the search field of the task window from excel. So I loaded the string to the clipboard and used send keys to "Ctrl E" (enter search field) then "Ctrl V" paste. This routine turns num lock off. So I added a toggle for that.
Sub btn_GotoTask()
Set cl = New clsClient
' Folders may contain any type of item
Dim myItem As Object
Dim myItems As items
Dim resItems As items
Dim myTaskFolder As Folder
Dim sFilter As String
Dim msgPrompt As String
On Error GoTo outlookError
Set myTaskFolder = Session.GetDefaultFolder(olFolderTasks)
myTaskFolder.Display
SetClipboard cl.Pol
'Activate task window
myTaskFolder.Application.ActiveWindow
SendKeys "^{e}"
SendKeys "^{v}"
SendKeys "{NUMLOCK}"
Exit Sub
outlookError:
MsgBox "Outlook may not be open"
End Sub
I use a outlook rule to process incoming mail via a VBA macro.
in the vba various actions are triggerd to process attachments of the incoming mail.
The problem is, there somethimes is a stack of e-mails that need to be processed.
I cant seem to find a way how to trigger the one by one.
I want to wait a few seconds before processing the next mail, if there is a stack.
Putting a sleep method in the macro doesnt seem to have effect. the rule doesnt seem to wait for the previous message to be done.
My method i something like:
Is there a way to accomplish this behaviour?
Private Sub ProcessMail(ByVal Item As Object)
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
If TypeOf Item Is Outlook.MailItem Then
Dim Msg As Outlook.MailItem
DoProcessingMethod
End If
End If
End Sub
Putting a wait or sleep in the method doesnt cause it to be processed one by one.
GD Arnold,
You could indeed use the ItemAdd option as per #Brett's answer.
I use a similar process to automatically upload received data (as attachment in an email) and upload this to a MySQL database. The action is triggered by the ItemAdd method and mails are checked one-by-one.
Simplified instructions:
Add a Class to your VBA code named "EventClassModule"
In your class, type
Public WithEvents dItems As Outlook.Items
In your ThisOutlookSession make a sub that registers the event_handler:
Sub Register_Event_Handler()
Set myClass.dItems = Outlook.Items
End Sub
In your ThisOutlookSession make a sub that handles the ItemAdd event as below:
Private Sub dItems_ItemAdd(ByVal newItem As Object)
On Error GoTo ErrorHandler
Dim msg As Outlook.MailItem
If newItem.Class = olMail Then
Set msg = newItem
'Do something with the msg item, check rules, check subject, check whatever
'This will process messages when the arrive in your mailbox one by one.
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
These steps should provide you with a sub that is triggered when a new mail arrives.
You could then call a function/sub like below.
The below sub runs all rules based on an optional ruleSet variable, it checks the rule.Name against the ruleSet and if the ruleSet string exists in the rule.Name then it executes some code. This way you can have multiple rules and only execute some of them based on which 'ruleSet' they are part of. You can define that by altering their name.
It's a refinement of the 'Run Rules' option in Outlook.
Some of this code came frome here: Setting VBA to read personal inbox
Sub runRules(Optional ruleSet As String)
Dim olStore As Outlook.Store
Dim myRules As Outlook.Rules
Dim tmpInbox As Outlook.Folder
Dim tmpSent As Outlook.Folder
Dim rl As Outlook.Rule
'On Error Resume Next
'toTmpBox (ruleSet)
' get default store (where rules live)
Set olStore = Application.Session.DefaultStore
With olStore
Set tmpInbox = .GetDefaultFolder(olFolderInbox) '.Folders("tmpInbox")
Set tmpSent = .GetDefaultFolder(olFolderSentMail) '.Folders("tmpSentBox")
End With
' get rules
Set myRules = olStore.GetRules
' iterate through all the rules
For Each rl In myRules
Debug.Print rl.Conditions.Body.Enabled & " " & rl.Conditions.Body.Text
If InStr(LCase(rl.Name), ruleSet) > 0 And (rl.Enabled) Then
rl.Execute ShowProgress:=True, Folder:=tmpInbox
If ruleSet = "autorun" Then
rl.Execute ShowProgress:=True, Folder:=olStore.GetDefaultFolder(olFolderSentMail)
End If
ruleList = ruleList & vbCrLf & rl.Name
End If
Next
' tell the user what you did
ruleList = "These rules were executed " & _
vbCrLf & ruleList
MsgBox ruleList, vbInformation, "Macro: RunMyRules"
CleanUp:
Set olStore = Nothing
Set tmpInbox = Nothing
Set tmpSent = Nothing
Set rl = Nothing
Set myRules = Nothing
End Sub
I have come across a similar problem. In my case my tool would run at regular time interval and each time I had to capture new emails only. Now new emails could be one or multiple. the solution I found was as given below.
Each time the tool would run. it will capture the new emails and just mark a simple ',' or '|' anything of your choice at the end of the subject in such a way that no one will notice. Now next time when the tool runs it checks if the emails received for the entire day or two (based on your requirements) has those markers or not.
This solution works if the email communication is one way. If we use these email for chain emails then their is another solution.
Here you will have to save the time max time of emails captured in the last run. Now each time you run you just have to run it for the entire day and put an if statement that is should be greater then time last captured.
Now to store the max time you might need to create a folder and an email. The email can help you to store the each time the run happens
item.subject = maxtime
item.save