Detect when a new e-mail has been created (WithEvents) - excel

I am trying to call a procedure stored in Outlooks' 'ThisOutlookSession', from an Excel workbook. Unfortunately the Newer Outlook 2010 app does not have compatibility with the application.run *SubName* between MS office products.
It is not an option to complete an Excel script that sends the email on Outlooks behalf due to security messages on '.send' which requires a manned station. (& unable to change security settings from company policy)
Current workflow...
-User sends me an e-mail with 'command' in subject & attachments
-Event listener finds and successfully runs an Excel routine on attachments with the below headers for listening in Outlook
Private WithEvents Items As Outlook.Items
&
Private Sub Items_ItemAdd(ByVal Item As Object)
-Once processed in Excel, I am trying to get this data automatically returned to sender. (This is where the problem is)
I am using late binding in Excel to create and ready the return e-mail. It is one step before '.send'. I would ideally like to avoid a SendKeys statements because it is not fully reliable if working on other workbooks at the same time.
In Excel...
Sub test()
Dim aOutlook As Object
Dim aEmail As Object
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
aEmail.To = "My email address"
aEmail.Subject = "Testing"
aEmail.Body = "Testing"
aEmail.display
End Sub
I have been endlessly trying to get Outlook to recognise Excel creating this new email with events listed in the MSDN pages. I think something like the below code is what is needed to identify a new mailitem, but no success using most of the preset declarations under the Outlook.mailItem.
Private WithEvents NewItem As Outlook.mailItem
Please let me know if you have solution or an alternative idea for me to pursue

Solved, if anyone needs this in the future. It bypasses security warnings and does not rely on send-keys.
Excel prepares an email and displays it - when prepared, the 'On event' from Outlook recognises the 'to' address when the mailitem is loaded, and can then take over from there: finishing with a .send statement.
Note, more parameters will need to be added such as a specific code in the item.subject to ensure that its the correct e-mail that's being sent.
In Excel:
Sub test()
Dim aOutlook As Object
Dim aEmail As Object
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
aEmail.To = "abs#123.com"
aEmail.Subject = "Testing"
aEmail.Body = "testing"
aEmail.Display
End Sub
In Outlook:
Public WithEvents myItem As Outlook.mailItem
Private Sub Application_ItemLoad(ByVal Item As Object)
If (TypeOf Item Is mailItem) Then
Set myItem = Item
End If
End Sub
Private Sub myItem_Open(Cancel As Boolean)
If myItem.To = "abs#123.com" Then
MsgBox "Detected"
myItem.Send
End If
End Sub

Related

Check outlook emails of past 7 days

I am trying to code a macro which checks the mails of the default outlook folder of the last seven days and extracts the body of the mail to an existing excel sheet if the mail contains a specific subject and sender name.
I already coded a macro, which checks every new mail as soon as received and extracts the content to excel if the specific subject & sender name is given. Although it worked, it was not a good solution for me to automatically check every new incoming mail. The code is:
Option Explicit
Private WithEvents olItems As Outlook.Items
Private Sub Application_Startup()
'Variablen dimensionieren
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
'Variabeln initialisieren
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub olItems_ItemAdd(ByVal item As Object)
'Variablen dimensionieren
Dim olMail As Outlook.MailItem
Dim oxLApp As Object, oxLwb As Object, oxLws As Object
'Prüfen ob Item eine Mail ist
If TypeName(item) = "MailItem" Then
Set olMail = item
If InStr(olMail.Subject, "APPROVAL REQUIRED") And _
olMail.SenderName = "Test, Name" Then
Set oxLApp = GetObject(, "Excel.Application")
Set oxLwb = oxLApp.Workbooks.Open _
("C:\Users\A2000\Desktop")
Set oxLws = oxLwb.Sheets("Slide 3")
With oxLws
.Range("Q24") = olMail.VotingResponse
.Range("E41") = olMail.Body
End With
End If
End Sub
Any ideas how to check the mails of the last seven days?
You can use the Restrict or Find/FindNext methods of the Items class to get items that corresponds to the search criteria. Read more about them in the following articles:
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
The search criteria can be:
sFilter = "[RecievedTime] > '" & Format("1/15/22 3:30pm", "ddddd h:nn AMPM") & "'"
The MailItem.ReceivedTime property returns a Date indicating the date and time at which the item was received.
If you need to get such items from multiple folders at once you may consider 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). 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.
Read more about that in the Advanced search in Outlook programmatically: C#, VB.NET article.

How to use Outlook's Application_AdvancedSearchComplete event handler in Excel VBA?

I wrote VBA code in Outlook to use AdvancedSearch. It worked.
When I moved it to Excel to be part of a larger routine, the event handlers stopped working.
The main code looks something like this.
Public gblnProcessAttachmentsDone As Boolean
Public gblnProcessAttachmentsStopped As Boolean
Sub ProcessAttachmentsSub()
' this routine performs the advanced search on a folder
...
gblnProcessAttachmentsDone = False
gblnProcessAttachmentsStopped = False
...
'perform search
Set objSearch = objOL.AdvancedSearch(strScope, strFilter, True, "ProcessAttachments")
Do Until gblnProcessAttachmentsDone
DoEvents
Loop
These are the event handlers.
Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Outlook.Search)
' this routine identifies the search that has just completed
If SearchObject.Tag = "ProcessAttachments" Then
Debug.Print "Search completed at " & Time
gblnProcessAttachmentsDone = True
End If
End Sub
Private Sub Application_AdvancedSearchStopped(ByVal SearchObject As Outlook.Search)
' this routine identifies the search that has just been stopped by the user
If SearchObject.Tag = "ProcessAttachments" Then
Debug.Print "Search stopped at " & Time
gblnProcessAttachmentsStopped = True
gblnProcessAttachmentsDone = True
End If
End Sub
I tried placing them in 'ThisWorkbook' and a Class module, but in both cases the events never get caught.
In Excel VBA, Application intrinsic variable points to Excel.Application, not Outlook.Application. Your event handler (Application_AdvancedSearchStopped) will not be automatically hooked up. Declare objOL with events and set up the event handler,.
To start an Outlook Automation session, you can use either early or late binding. Late binding uses either the Visual Basic GetObject function or the CreateObject function to initialize Outlook. For example, the following code sets an object variable to the Outlook Application object, which is the highest-level object in the Outlook object model. All Automation code must first define an Outlook Application object to be able to access any other Outlook objects.
Dim objOL as Object
Set objOL = CreateObject("Outlook.Application")
To use early binding, you first need to set a reference to the Outlook object library. Use the Reference command on the Visual Basic for Applications (VBA) Tools menu to set a reference to Microsoft Outlook xx.x Object Library, where xx.x represents the version of Outlook that you are working with. You can then use the following syntax to start an Outlook session.
Dim objOL as Outlook.Application
Set objOL = New Outlook.Application
To handle Outlook Application-level events in external applications:
First, you must declare a variable using the WithEvents keyword to identify the object whose event you want to handle.
Dim WithEvents objOL as Outlook.Application
Set objOL = New Outlook.Application
You can then select an Outlook application instance object in the Objects list of the module window and then select the event in the procedure list. The Visual Basic Editor will then add the template for the event procedure to the module window. You can then type the code you want to run when the event occurs.
Private Sub objOL_AdvancedSearchComplete(ByVal SearchObject As Outlook.Search)
' this routine identifies the search that has just completed
If SearchObject.Tag = "ProcessAttachments" Then
Debug.Print "Search completed at " & Time
gblnProcessAttachmentsDone = True
End If
End Sub
Read more about the AdvancedSearch method in the Advanced search in Outlook programmatically: C#, VB.NET article.

Retrieving Outlook email data using Excel VBA

I am trying to grab the following details from the sent items folder with subject "Index Coverage".
Sent by
Sent to
Subject
Sent on (date)
email body
I am using formulas in the sheet with code in the ThisOutlookSession module
Index: =TRIM(MID(G2,SEARCH("Code",G2)+(8+LEN("Code")),20))
Our client: =LEFT(I2,FIND("on",I2)-1)
End client: =LEFT(K2,FIND(".",K2)-1)
Const strFilePath As String = "C:\Users\Public\Documents\Excel\OutlookMailItemsDB.xlsx"
Const strSubjectLineStartWith As String = ""
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim varArray As Variant
Dim strSub As String
Dim strBody As String
Dim strArray() As String
Dim lngLoop As Long
Dim objItem As Object
Dim lngMailCounter As Long
Dim objMItem As MailItem
strArray = Split(EntryIDCollection, ",")
For lngMailCounter = LBound(strArray) To UBound(strArray)
Set objItem = Session.GetItemFromID(strArray(lngMailCounter))
If TypeName(objItem) = "MailItem" And InStr(1, objItem.Subject, strSubjectLineStartWith) And InStr(1, objItem.Body, "") Then
Set objMItem = objItem
With CreateObject("Excel.Application").workbooks.Open(strFilePath)
With .sheets(1)
With .cells(.rows.Count, 1).End(-4162)(2).resize(1, 7)
.Value = Array(objMItem.SenderEmailAddress, objMItem.To, objMItem.CC, objMItem.BCC, objMItem.Subject, objMItem.ReceivedTime, objMItem.Body)
End With
End With
.Close 1
End With
Set objItem = Nothing
End If
Next lngMailCounter
If Not IsEmpty(strArray) Then
Erase strArray
End If
End Sub
I am able to grab:
sent by
subject
sent on
Body
Index
Our client
End client
I am not able to grab the recipient contact details.
Also the Excel sheet placed on the desktop needs to be saved and closed on its own so that next time it doesn't throw an error that Excel is not closed.
Also it should consider the sent items folder with the following subject line: "Index Coverage".
Also to grab the details for Index, Our client and End client I am using Excel formulas. Is it possible to achieve this via VBA?
First of all, creating a new Excel instance in the NewMailEx event handler each time a new email is received is not really a good idea. I'd suggest keeping a reference when the add-in works (like a singleton) to prevent any additional workload when receiving a new item.
Try to use the Recipients property of the MailItem class instead of using the To, Cc or Bcc fields. The Recipients collection returns a Recipients collection that represents all the recipients for the Outlook item. Use Recipients(index) where index is the name or index number, to return a single Recipient object. The name can be a string representing the display name, the alias, or the full SMTP email address of the recipient.
Finally, to process items added to the sent items folder you need to handle ItemAdd event which is fired when one or more items are added to the specified collection.
Public WithEvents myOlItems As Outlook.Items
Public Sub Initialize_handler()
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentItems).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
' your code for processing the Item object goes there
End Sub

Prompt Message After Sending Outlook Mail using Excel VBA

I have an Excel UserForm which upon a button click generates an Outlook E-mail and the user manually clicks the send option on the mail.
The system will register the E-mail content in an Excel database (only if the user clicks on the Send Option in Outlook through an Withevents Class).
If the database is not available there is an error message which should prompt the user. The prompt is not showing to the user (covered by the Outlook E-mail) because Excel code is processing and the E-mail sending process will be waiting for it to be done.
Is there any way I can show the message box on top of Outlook or run the code to save to the database but only AFTER the Send option is clicked?
The code in the Userform to fill and display the E-mail in Outlook.
Public itmevt As New CMailItemEvents
Public Outapp As Outlook.Application
Public Outmail As Outlook.MailItem
public subject as string
public body as string
Private Sub SendMail_Click()
Set Outapp = New Outlook.Application
Set Outmail = Outlook.Application.CreateItem(0)
Set itmevt.itm = Outmail
body=userform.text1.text
subject=userform.text2.text
itmevt.itm.Subject = "Some Subject"
With itmevt.itm
.HTMLBody = Body
.Subject = subject
.Display
End With
this is the code for the Class called (CMailItemEvents) to detect the Send Option Click
Option Explicit
Public WithEvents itm As Outlook.MailItem
Private Sub itm_Send(Cancel As Boolean)
EmailsForm.savedetails
End Sub
once the Send Option is clicked the code to save will run
sub savedetails()
--->Open Excel DB
If DB.ReadOnly Then
Msgbox ("Error Message Here") ----> here is the problem, the message shows on excel
--- but the outlook mail is on the front of the screen
exit sub
else
--->Save details to DB
End Sub
I tried to keep the code sample as short and simple as possible.
I was finally able to do it with a workaround, I'm not sure if this is going to help anyone.
I've created another event watcher to detect when the E-mail window is actually closed, and according to that the message will be triggered.
this is the updated Class to detect the Send click & the E-mail deactivation event:
Option Explicit
Public WithEvents itm As Outlook.MailItem
Public WithEvents appv As Inspector ----> this part is added
Public Sent as Boolean
Private Sub itm_Send(Cancel As Boolean)
Sent=True ---> Sending E-mail Check
EmailsForm.ETo = itm.To
EmailsForm.ECC = itm.CC
EmailsForm.savedetails
End Sub
---This Part Is Added---
Private Sub appv_Deactivate()
If Sent = True then ---> Sending E-mail Check To Avoid Triggering the watcher if the E-mail is closed without sending
if EmailsForm.Bool=true then
msgbox ("Error Message Here")
EmailsForm.Book=False
Sent=False
End If
End If
End Sub
when the user click the button on the user form the following code it triggered:
Public itmevt As New CMailItemEvents
Public Outapp As Outlook.Application
Public Outmail As Outlook.MailItem
public subject as string
public body as string
Private Sub SendMail_Click()
Set Outapp = New Outlook.Application
Set Outmail = Outlook.Application.CreateItem(0)
Set itmevt.itm = Outmail
Set itmevt.appv = Outmail.GetInspector ----> this is added to link the E-mail window to the deactivation trigger
body=userform.text1.text
subject=userform.text2.text
itmevt.itm.Subject = "Some Subject"
With itmevt.itm
.HTMLBody = Body
.Subject = subject
.Display
End With
I've added a Boolean to be checked from the call
public Bool as Boolean
sub savedetails()
Bool=false ---> Boolean to be checked by the class
--->Open Excel DB
If DB.ReadOnly Then
Bool=true
exit sub
else
--->Save details to DB
End Sub
I hope the above is clear and can help anyone with similar issue; thank you for your support everyone
I've had to deal with stubborn applications myself. Try hiding the application then showing it before your msgbox.
If DB.ReadOnly Then
Application.Visible = False
Application.Visible = True
MsgBox "Error Message Here"
End If
Probably not the most elegant of solutions - but it usually works.

Retroactive link between outlook and vba

I’m currently working on an access Vba program in order to automatically write mails to people. However we chose to still press ‘Send’ in Outlook manually (in case there are possible issues, so we can control the mail beforehand).
Is there a way to have a link in the other direction, as in, when pressing the Send button in Outlook, getting the email address of the person back in excel? (The goal would be to make a ‘history’ sheet in order to keep track of which mails were actually sent and to whom)
Thank you!
Yes. A simple case is shown below. This is bare bones demonstrating the actions you requested.
Public variable, addressSent, holds the To address. A boolean test on mail sent (by #Rory) tests for the mail item having been sent and calls a function, by #Dwipayan Das, that opens a specified Excel file, and writes the addressSent to cell A1 in sheet1.
You can tinker with this to fit your purposes. E.g. Adapt the function to accept a file name as parameter.....
Taking a note from #ashleedawg's book: remember to include a xlApp.Quit line so Excel is not left hanging.
I believe your question wanted to go from Outlook to Excel so this is the application that you will have created that needs closing.
So in Outlook goes the following code:
Put this in a standard module:
Option Explicit
Public addressSent As String
Dim itmevt As New CMailItemEvents
Public Sub CreateNewMessage()
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
Set itmevt.itm = objMsg
With objMsg
.Display
.To = "somebody#mail.com"
.Subject = "Blah"
addressSent = .To
.Send
End With
End Sub
Public Function openExcel() As Boolean 'Adapted from #Dwipayan Das
Dim xlApp As Object
Dim sourceWB As Object
Dim sourceWS As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
End With
Dim strFile As String
strFile = "C:\Users\User\Desktop\Delete.xlsb" 'Put your file path.
Set sourceWB = xlApp.Workbooks.Open(strFile, , False, , , , , , , True)
sourceWB.Activate
sourceWB.Worksheets(1).Range("A1") = addressSent
End Function
Then in a class module called CMailItemEvents, code from #Rory, put the following:
Option Explicit
Public WithEvents itm As Outlook.MailItem
Private Sub itm_Close(Cancel As Boolean)
Dim blnSent As Boolean
On Error Resume Next
blnSent = itm.Sent
If Err.Number = 0 Then
Debug.Print "not sent"
Else
openExcel
End If
End Sub
References:
Check to see if an Outlook Email was sent from Excel VBA
How can I use Outlook to send email to multiple recipients in Excel VBA
How to open an excel file in Outlook vba code
Create a new Outlook message using VBA
Run code after item sent
Just a quick 'n dirty function that will run in Excel/Access/Word and returns the email address from the most recent item in the Sent Items folder (no error handling, etc):
Function LastSentEmailAddress() As String
'Requires reference: "Microsoft Outlook xx.x Object Library"
Dim olApp As Outlook.Application, olMail As Object
Set olApp = New Outlook.Application 'create Outlook object
Set olMail = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items.GetLast
LastSentEmailAddress = olMail.Recipients(1).PropertyAccessor.GetProperty( _
"http://schemas.microsoft.com/mapi/proptag/0x39FE001E") 'get email addy
olApp.Quit 'close Outlook
End Function
A Note about working with Outlook objects from Excel:
When working with applications such as Excel it's important to make sure the application object is properly .Quit / .Close'd when finished with them, (and to Set all objects to Nothing), otherwise there's a risk of inadvertently having multiple instances running, which can lead to memory leaks, which leads to crashes and potential data loss.
To check if there is an existing instance of Outlook, use this function:
Function IsOutlookOpen()
'returns TRUE if Outlook is running
Dim olApp As Outlook.Application
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
IsOutlookOpen= False
Else
IsOutlookOpen= True
End If
End Function
(Source: Rob de Bruin)
More Information:
MSDN : Items.GetLast Method (Outlook)
MSDN : Items Object (Outlook)
MSDN : Obtain the E-mail Address of a Recipient
Office.com : How to disable warnings about programmatic access to Outlook
MSDN : Chapter 17: Working with Item Bodies (Book Excerpt)
MSDN : Check or Add an Object Library Reference
Stack Overflow : VBA to search an Outlook 2010 mail in Sent Items from Excel

Resources