I have a macro that runs on the Application_NewMail event - but I've seen it have weird impacts if the user is currently composing an email or reply - sometimes crashing outlook and losing their progress.
Is there a way that I can detect whether the user is currently composing an email?
This would allow me to cancel the macro and avoid interrupting the user.
I was able to find bits and pieces from related questions, but nothing that took into account both the pop-up email editor and the inline-response. Here's the solution I pulled together (which seems to cover all bases):
Private Function IsUserEditing() As Boolean
' Check if the user is composing an email. Don't interrupt them if we are.
' 1. Check if the user has the pop-up email 'inspector' window open
If Not (Application.ActiveInspector Is Nothing) Then
Dim OpenWindow As Variant
Set OpenWindow = Application.ActiveInspector.CurrentItem
If TypeOf OpenWindow Is MailItem Then
Dim NewMail As MailItem
Set NewMail = OpenWindow
' Check if the mail they're viewing is not 'Sent' (i.e. being edited)
If Not (NewMail.Sent) Then
IsUserEditing = True
Exit Function
End If
End If
' 2. Check if the user is replying to an email using the 'inline response' feature
ElseIf Not (Application.ActiveExplorer.ActiveInlineResponse Is Nothing) Then
IsUserEditing = True
Exit Function
End If
IsUserEditing = False
End Function
It can be used like this:
Private Sub Application_NewMail()
Debug.Print "New mail received..."
' Check if the user is composing an email. Don't interrupt them if we are.
If IsUserEditing Then
Debug.Print "User appears to be composing an email. Cancelling..."
Exit Sub
End If
' Otherwise Proceed
PerformOnNewMailActions
End Sub
Hope this helps others!
Related
At our company, we use Outlook Exchange Desktop edition. Some of us have multiple accounts to send/receive emails from. I have created a VBA macro to check for each email when pressing the Send button what account they are sending the mail from, and then to create a handler that checks if this mail arrives in the "Sent items" folder. After arriving it takes this mail and saves it to a predefined folder.
At first I created this macro to only work with the default account and default folder for sent mail. It worked perfectly. Now I added some code to check the account it is sent from in the correct "Sent items" folder (the one of the correct account). Therefore I used the MailItem.SendUsingAccount property.
When applying this macro, 8 out of 10 times, I get the correct account and the macro works fine. The other 2 times, the SendUsingAccount property return "Null" or "Nothing" (I don't know the difference between these two). I found an other thread here where another user suggests the assignment of accounts to Mailitems is not always reliable, but it doesn't state a proper solution to my problem. Why do I sometimes get nothing as a returnvalue and other times it works perfectly fine? When it's not working, it's always about the code line: ZendAcc = Item.SendUsingAccount. Here the ZendAcc variable cannot store the empty SendUsingAccount return.
VBA:
Public WithEvents myOlItems As Outlook.Items
'Sub triggered when pressing the send button in outlook email
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim ZendAcc As String
'Checking for multiple accounts
If Application.Session.Accounts.Count > 1 Then
'Check if the itemtype is MailItem. (normally it will always be correct)
If TypeName(Item) <> "MailItem" Then
MsgBox "There is no MailItem"
Exit Sub
Else
'Store AccountName in String
ZendAcc = Item.SendUsingAccount
If ZendAcc = "" Then
Exit Sub
End If
'Create the handler and give it the Accountname String
Call Initialize_handler(ZendAcc)
End If
Else
'When there is only one account, the Accountname doesn't matter, but you need a String
Call Initialize_handler("Useless")
End If
End Sub
Public Sub Initialize_handler(ByVal zendAccount As String)
Dim Store As Store
Dim Folder As Folder
'If there are multiple accounts, check for the right sent mails folder, otherwise use the default one.
If Application.Session.Accounts.Count > 1 Then
For Each oAccount In Application.Session.Accounts
If oAccount.SmtpAddress = zendAccount Then
Set Store = oAccount.DeliveryStore
Set acFolder = Store.GetDefaultFolder(olFolderSentMail)
Exit For
End If
Next
Set myOlItems = acFolder.Items
Else
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items
End If
End Sub
'Catch the added mail and save to folder
Private Sub myOlItems_ItemAdd(ByVal ObjectSent As Object)
'Code to do something with this mail. In my case: store to defined folder.
End Sub
If the account was explicitly set and the message has not been saved first, you might get null (aka Nothing in VB). In that case, assume the very first account from the Application.Session.Accounts collection will be used.
i have created a outlook macro where if i want to send email other then the listed email id,it will give me a popup. However, i am not being able to add multiple email ids to the list. please find the below code that i have written. Can someone please help me how to add multiple email ids in my below code?
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Const ADDR_TO_WATCH_FOR = "James.t#outlook.com"
Dim olkRec As Outlook.Recipient
If Item.Class = olMail Then
For Each olkRec In Item.Recipients
If LCase(olkRec.Address) <> ADDR_TO_WATCH_FOR Then
If MsgBox("This message is addressed to " & ADDR_TO_WATCH_FOR & ". Are you sure you want to send it?", vbQuestion + vbYesNo, "Confirm Send") = vbNo Then
Cancel = True
End If
Exit For
End If
Next
End If
Set olkRec = Nothing
End Sub
Don't show the message box inside the loop over all recipients. Run the loop first and check all recipients. Build a list of multiple recipients if necessary. After you exit the loop, check if that list (a string) if not empty, show the message box.
I have a script to process emails. User's can kick this script off by using a form.
I want them to only be able to use the form if they have an email open and in focus. So how can I check that the CurrentItem in:
objApp.ActiveInspector.CurrentItem
Is an email and is not another open window?
To work with mail item that is open and has focus, use ActiveInspector method
Example blew to print subject if Item is Mailitem
Option Explicit
Sub Item_Info()
Dim Active_Item As Object
Set Active_Item = Application.ActiveInspector.CurrentItem
If TypeOf Active_Item Is Outlook.MailItem Then
Debug.Print Active_Item.Subject
End If
End Sub
My client service system sends email notifications when a new inquiry comes in. I am able to reply to the notification and the system will update the inquiry with information from my email reply.
Reply example:
To: "client inquiry system"
Subject: Re: I am having password trouble Inquiry:5601
Body of email below:
Your password has been reset.
The above will append "Your password has been reset." to the inquiries description.
I am also able to trigger changes to Status ( i.e. Closed, Resolved, Defunct) if I place special syntax at the top of the email body.
To: "client inquiry system"
Subject: Re: Inquiry:5601 -- I am having password trouble
Body of email below:
Status=Closed
Your password has been reset.
The above will set the inquiry to Closed in my system.
I would like to use a form or macro button that will provide users with drop down selections or free form text that will be added to the top of the email body once set.
I have some familiarity with VBA, but very new. Please help!
I am not convinced by your reply to my comment but this answer is an attempt to be helpful. It includes four macros that demonstrate functionality you will need. I hope it is enough to get you started.
When you open Outlook’s Visual Basic Editor, you will see something like the following down the left side of the screen. If you do not see it, click Ctrl+R.
- Project 1 (VbaProject.OTM)
- Microsoft Office Outlook Objects
ThisOutlookSession
- Modules
Module1
The hyphens will be in little boxes. If any hyphen is a plus, click the plus to expand the list under the heading.
Click ThisOutlookSession. You will get an empty code area on the right. This is like a module code area but is used for event routines. Copy this code into that area:
Option Explicit
Public WithEvents MyNewItems As Outlook.Items
Private Sub Application_Startup()
' This event routine is called when Outlook is started
Dim NS As NameSpace
Dim UserName As String
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
With NS
UserName = .CurrentUser
Set MyNewItems = .GetDefaultFolder(olFolderInbox).Items
End With
MsgBox "Welcome " & UserName
End Sub
Private Sub myNewItems_ItemAdd(ByVal Item As Object)
' This event routine is called each time an item is added to Inbox
' because of:
' Public WithEvents MyNewItems As Outlook.Items
' Set MyNewItems = .GetDefaultFolder(olFolderInbox).Items
With Item
Debug.Print "#####" & Format(Now(), "dMmmyy hh:mm:ss") & _
": Item added to Inbox with Subject: [" & .Subject & _
"] from [" & .SenderEmailAddress & "] with Text body"
Debug.Print .Body
End With
End Sub
Close Outlook and click Yes for “Do you want to save the VBA project ‘VbaProject.OTM?’”
Reopen Outlook. You will be told a program is trying to access email addresses. Click Allow access for, select 10 minutes and click Yes. You will get a window saying “Welcome John Doe”.
If this does not happen, select Tools then Macros then Security. Security level Medium must be selected to use macros safely.
The macro Application_Startup() has accessed Outlook’s email database. It is not easy to avoid the user being asked to allow access since Outlook has a very robust security system. There is a four step self-certification process which should allow you suppress this question for your own macros. I have successfully performed the first three steps but have never mastered the fourth step. I have carefully followed such instructions as I can find on the web but nothing has worked for me. Perhaps you will be more successful or perhaps you have access to an expert who can guide you if you want to suppress this question
The macro Application_Startup() has done two things: issued the welcome message and initialised MyNewItems. The welcome message is just a demonstration that you can access the user’s name which might be useful if you have a shared Inbox. Initialising MyNewItems activates the event routine myNewItems_ItemAdd(). This outputs details of the each new item to the Immediate Window.
This is a quick demonstration of event routines which I thought would be useful to you. However, I have discovered that if myNewItems_ItemAdd() is busy with one item when a second arrives, it is not called for the second item. I use a very old version of Outlook and this may be a bug that has been cleared in later releases. If you decide to use event routines, you need to check this out.
Another way of getting access to emails is Explorer. Insert a new module and copy the following code into it:
Option Explicit
Public Sub DemoExplorer()
Dim Exp As Outlook.Explorer
Dim ItemCrnt As MailItem
Dim NumSelected As Long
Set Exp = Outlook.Application.ActiveExplorer
NumSelected = Exp.Selection.Count
If NumSelected = 0 Then
Debug.Print "No emails selected"
Else
For Each ItemCrnt In Exp.Selection
With ItemCrnt
Debug.Print "From " & .SenderName & " Subject " & .Subject
End With
Next
End If
End Sub
DemoExplorer() shows another way of giving a macro access to mail items. The user selects one or more emails and then activates the macro DemoExplorer(). Again this just outputs some properties of a mail item to the Immediate Window.
Click F2 and the code window is replaced by a list of libraries. Scroll down the list of Classes and select MailItem. The right hand window displays all the members of MailItem. Some, such as ReceivedTime, are obvious but you will probably have to look up most. I suggest you make a note of all that look useful. Click a module, to get back to a code window when you have finished.
DemoReply(), below, is an updated version of DemoExplorer() which replies to selected emails. Add this code to your module:
Public Sub DemoReply()
Dim Exp As Outlook.Explorer
Dim ItemCrnt As MailItem
Dim Reply As MailItem
Dim Subject As String
Dim SenderAddr As String
Dim Received As Date
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Debug.Print "No emails selected"
Else
For Each ItemCrnt In Exp.Selection
' Get properties of message received
With ItemCrnt
Subject = .Subject
SenderAddr = .SenderEmailAddress
Received = .ReceivedTime
End With
' Create reply
Set Reply = CreateItem(olMailItem)
With Reply
.BodyFormat = olFormatPlain
.Body = "Thank you for your enquiry" & vbLf & _
" Subject: " & Subject & vbLf & _
" Received at: " & Format(Received, "d Mmm yyyy h:mm:ss") & vbLf & _
"which will be handled as soon as an analyst is available."
.Subject = "Thank you for your enquiry"
.Recipients.Add SenderAddr
' Display allows the user to review the reply before it is written to Outbox
' but control is not returned to this macro. Only the first select mail item
' will be processed
' Send gives the user no opportunity to review the replies but the macro does not
' use control so all replies are sent.
'.Display
.Send
End With
Next
End If
End Sub
I use an Outlook address for my private email and a Gmail address for my public email. I sent myself some text emails from the Gmail address. In Outlook, I selected these emails and activated DemoReply(). The expected replies arrived in my Gmail Inbox. Try sending yourself some emails and the try replying.
To demonstrate the use of a useform within Outlook, I inserted a new form and left the name as the default UserForm1. I dragged two text boxes to the form which I left with their default names of TextBox1 and TextBox2. I also dragged a command button which I renamed cmdSend.
An Outlook macro can only communicate with a user form via global variables. Add the following at the top of the module; they must be placed before any macros:
Public Box1 As String
Public Box2 As String
Add this macro to the module:
Sub DemoForm()
' Initialise global variables to be used by form before it is loaded
Box1 = "Initial value for text box1"
Box2 = "Initial value for text box2"
Load UserForm1
UserForm1.Show vbModal
' Control does not return to this module until user releases control of form
Debug.Print Box1
Debug.Print Box2
End Sub
Add this code to the form:
Private Sub cmdSend_Click()
Box1 = TextBox1
Box2 = TextBox2
Unload Me
End Sub
Private Sub UserForm_Initialize()
TextBox1 = Box1
TextBox2 = Box2
End Sub
Activate DemoForm(). The form will appear with the text boxes set to "Initial value for text box1" and "Initial value for text box2". Change these values and click Send. Control will be returned to DemoForm() which outputs the new values to the Immediate Window.
i have about ten responses from StackOverflow open but none of them quite answer my problem.
i have created several UserForms in Excel VBA for this particular project. (Note: i have no formal training on VBA programming and everything i have done is self-taught or gleaned from copying other people's codes.) While interfacing with more than one of these forms, i want the user to be able to access a command to select a user-name from the company's Global Address List. With a command button on the form and the following function i am able to do this:
Public Function GetUsernameFromOutlook(sCap As String) As String
'fancy code to call Outlook dialog box to select names.
'Badresult is the default, gives username of operator if they try to:
' select more than one recipient
' cancel out of the dialog box
Dim olApp As Object ' Outlook.Application
Dim olDialog As Object ' Outlook.SelectNamesDialog
Dim hwnd As Long
Set olApp = CreateObject("Outlook.Application")
Set olDialog = olApp.Session.GetSelectNamesDialog
With olDialog
.Caption = sCap
.ForceResolution = True
.AllowMultipleSelection = False
.NumberOfRecipientSelectors = olShowTo
.ToLabel = "Select User"
If .Display = False Then GoTo BadResult
SetForegroundWindow (Excel.Application.hwnd)
If .Recipients.Count <> 1 Then GoTo BadResult
'Debug.Print .Recipients(1).Name
'Debug.Print .Recipients(1).Address
'Debug.Print .Recipients(1).AddressEntry.GetExchangeUser.Alias
GetUsernameFromOutlook = .Recipients.Item(1).AddressEntry.GetExchangeUser.Alias
End With
' hwnd = FindWindow(vbNullString, sCap & ": Global Address List")
Set olApp = Nothing
Set olDialog = Nothing
Exit Function
BadResult:
SetForegroundWindow (Excel.Application.hwnd)
GetUsernameFromOutlook = Environ("UserName")
End Function
As you can see i attempted to use the SetForegroundWindow and FindWindow API calls as suggested in other answers. But the code doesn't even reach these lines before causing the problem.
The line If .Display = False brings up the SelectNamesDialog box from Outlook, but because my UserForm is modal (i think), it stays as the visible window. i am forced to use Alt-Tab to switch to Outlook. Then, after either selecting a name or cancelling out of the Outlook dialog box, i need to Alt-Tab again to get back to Excel.
Also, because the code is waiting for a response from the Outlook box, there is no further code execution, so SetForegroundWindow doesn't even happen until i complete all of the Alt-Tab switching.
Other solutions posted have referred to using calls to MSWord, or looking up information from or saving to a spreadsheet. i'm trying to use this call to modify the caption or text of a form control, such as a command button or text box or text label. i only need to collect the Outlook alias, since i have another function which can collect other selected information from Outlook based on the alias, so the alias is saved in a tag (unseen) on the form and converted to full name, initials or e-mail address as needed using this other function.
So far everything works great and i'd really like to release this interface to my beta-testers, but i don't want to have to explain to everyone to use Alt-Tab after they click the "select name" button. They will believe their computer has locked up and do a hard re-start. (Or call IT who will start asking questions that they cannot answer.)
i'm sorry that this question is so long, but i wanted to include as much information as possible. i'm sure there will be things i need to clarify, so please send me your questions in a response and i will do my best to explain better. Thank you for your time.
I just spent an evening on this, so even if this thread is one year old it should help.
You should just try using:
"olApp.ActiveWindow.Activate"
It sums up to this fully working function:
enter Public Function GetUsernameFromOutlook(sCap As String) As String
'fancy code to call Outlook dialog box to select names.
'Badresult is the default, gives username of operator if they try to:
' select more than one recipient
' cancel out of the dialog box
Dim olApp As Outlook.Application ' Outlook.Application
Dim olDialog As Outlook.SelectNamesDialog
Dim hwnd As Long
Set olApp = New Outlook.Application
Set olDialog = olApp.Session.GetSelectNamesDialog
'Set olDialog = new Outlook.Application
With olDialog
.Caption = sCap
'.ForceResolution = True
.AllowMultipleSelection = False
.NumberOfRecipientSelectors = olShowTo
.ToLabel = "Select User"
olApp.ActiveWindow.Activate
.display
If .Recipients.Count <> 1 Then GoTo BadResult
'Debug.Print .Recipients(1).Name
'Debug.Print .Recipients(1).Address
'Debug.Print .Recipients(1).AddressEntry.GetExchangeUser.Alias
GetUsernameFromOutlook = .Recipients.Item(1).AddressEntry
End With
Set olApp = Nothing
Set olDialog = Nothing
Exit Function
BadResult:
GetUsernameFromOutlook = "A voir ultérieurement"
End Function here
Outlook Object Model does not let you specify the parent window of the address book dialog - it will always be Outlook.
On the Extended MAPI level (C++ or Delphi), you can specify the window handle when calling IAddbook::Address, but you cannot do that from VBA.
If using Redemption (I am its author) is an option, you can set the RDOSession.ParentWindow property before using the RDOSelectNames object.
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
Session.ParentWindow = Excel.Application.hwnd
set ABDialog = Session.GetSelectNamesDialog
ABDialog.Display true