Only run a macro if there is an email open - vba

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

Related

Replace Text in body and save

I receive emails that contain a link. That link does not work since I am not on that company's network. I can change part of the link for external use to get it to work.
For example the email has this link:
https://ipdms.web.companyname.com/ipdms/itemlocation
I change it to:
https://companyVPN.companyname.com/ipdms/itemlocation
I was able to create a script but I need to open the email, run the macro, and then hit save on the email.
Sub Change2VPN()
Application.ActiveInspector.CurrentItem.body = _
Replace(Application.ActiveInspector.CurrentItem.body, "ipdms.web", "companyVPN")
End Sub
I searched but have not been able to get anything to work. Is there a way I can either accomplish this on all items in a folder and save the email where it is or at least do it from the reading pane?
I can add the macro button to the ribbon.
I cannot run scripts as a rule on incoming emails due to corporate policies.
Basically you need to get the currently selected folder where a ribbon button was clicked and iterate over all items in the folder to get the job done:
Sub Change2VPN()
Dim olFolder As Outlook.Folder
Dim Item As Object
Dim explorer as Outlook.Explorer
Set explorer = Application.ActiveExplorer()
Set olFolder = explorer.CurrentFolder
For Each Item In olFolder.Items
If TypeOf Item Is Outlook.MailItem Then
Dim oMail As Outlook.MailItem: Set oMail = Item
oMail.HTMLBody = Replace(oMail.HTMLBody, "ipdms.web", "companyVPN")
oMail.Save()
End If
Next
End Sub

Detect whether an email is currently being edited in Outlook?

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!

Always CC when sending "On Behalf Of"

I often send emails on behalf of another user. I'd like to use VBA to automatically CC that user every time I send an email from/on behalf of that user.
I'm not familiar with VBA for Outlook but I'm thinking you could write an if statement that says "if sending message from UserX, cc UserX". The code should run automatically any time an email is sent on behalf.
SentOnBehalfOfName is tricky. It is usually empty until the item has been sent.
With this code in ThisOutlookSession you should find it blank.
Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
Dim myRecipient As Recipient
Debug.Print " item.SentOnBehalfOfName - " & item.SentOnBehalfOfName
If item.SentOnBehalfOfName = "someone#somewhere.com" Then
Set myRecipient = item.Recipients.Add("Someone Else")
myRecipient.Type = olCC
item.Recipients.ResolveAll
End If
End Sub
At least one way to get around this:
Sub createSentOnBehalf()
Dim objMsg As mailitem
Set objMsg = Application.CreateItem(olMailItem)
objMsg.SentOnBehalfOfName = "someone#somewhere.com"
objMsg.Display
Set objMsg = Nothing
End Sub
Sub replySentOnBehalf()
Dim objMsg As mailitem
Set objMsg = ActiveInspector.currentItem.reply
objMsg.SentOnBehalfOfName = "someone#somewhere.com"
objMsg.Display
Set objMsg = Nothing
End Sub
Edit: Just realized you could set the cc while creating / replying rather than waiting until ItemSend.
Edit2: Move the cc code from itemsend
Sub createSentOnBehalf()
Dim objMsg As mailitem
Dim myRecipient As Recipient
Set objMsg = Application.CreateItem(olMailItem)
objMsg.SentOnBehalfOfName = "someone#somewhere.com"
Set myRecipient = objMsg.Recipients.Add("Someone Else")
myRecipient.Type = olCC
objMsg.Recipients.ResolveAll
objMsg.Display
Set objMsg = Nothing
End Sub
This will do what you are looking for (It is the first Google results of "always CC myself Outlook")
http://www.extendoffice.com/documents/outlook/1108-outlook-auto-cc.html
Launch your outlook 2013 or 2010, and make sure that you are in the mail section. Then click Home > Rules > Manage Rules & Alerts.
After selecting Manage Rules & Alerts option, the Rules and Alerts dialog will popup. Under E-mail Rules, click New Rule option.
In the Rules Wizard, click Apply rule on messages I send then click Next to continue.
Then another dialog pops up.
(1.) In Step 1, check through the specified account box. In Step 2, please click on the word - specified.
(2.) And then click the Account drop down list to choose the account that you want to apply this rule.
After selecting the account, and click OK to return to the previous window, you will see the selected account showing in the Rules Wizard. Then click on Next button.
(1.) In this wizard, check Cc the message to people or public group box, and then click on people or public group in step 2.
(2.) In the Rule Address dialog box, double click your cc recipient to add the address to the To-> text box, (If I want to cc myself, I will select or type my own email address in the To-> column.), finally click OK.
It returns to the previous window, and you can see the cc recipient address appearing. Then click Finish button.
Now, it returns to the very beginning dialog, click OK button, then the cc rule will be created. If you don’t want to enable the rule, uncheck it.
Then after sending or forwarding an email message to others with your specified account, your account or your specific cc recipient will always receive the same message.
It looks like you need to handle the ItemSend event of the Application class. It is fired whenever an Microsoft Outlook item is sent, either by the user through an Inspector (before the inspector is closed, but after the user clicks the Send button) or when the Send method for an Outlook item, such as MailItem, is used in a program. Note, the Cancel parameter allows to cancel the process of sending the email.
In the ItemSend event handler you can check out the SentOnBehalfOfName property of the item passed as a parameter and add the CC recipient using the Recipients property of the MailItem class. The Recipients collection provides the Add method for adding recipients.
Set myRecipient = myItem.Recipients.Add("Dan Wilson")
myRecipient.Type = OlMailRecipientType.olCC
After don't forget to call the Resolve or ResolveAll method of the Recipient class to resolve a Recipient object against the Address Book.
See How To: Fill TO,CC and BCC fields in Outlook programmatically for more information.

In outlook 2010, How do I trigger a macro when a new mail is recieved in a secondary mailbox?

I have two mailboxes on my Outlook Profile and I need to perform a script whenever a new mail is recieved on my secondary mailbox.
you could do this with a piece of VB that runs in the background of your outlook to monitor your folder. Then from in the VB-code you could probably do whatever you want to happen.
First rightclick your ribbon, 'custimize the ribbon'.
There choose commands from 'All Tabs' and make sure you add the Developer one from the 'Main Tabs' to your ribbon.
Afterwards in your ribbon Developer-tab you can click on 'Visual Basic'
There in the overview you can see a Microsoft Outlook Object called 'ThisOutlookSession'.
Here we can put some code that will load when you start your outlook.
We'll create something basic to monitor a folder for incomming messages & how to handle them
Option Explicit
Private WithEvents SecondaryInbox As Items
Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Set Ns = Application.GetNamespace("MAPI")
Set SecondaryInbox = Ns.Folders("Name of Secondary Inbox").Folders("Inbox").Items
Set Ns = Nothing
End Sub
Public Sub SecondaryInbox_ItemAdd(ByVal Item As Object)
On Error Resume Next
' Do something on item add event..
If TypeName(Item) = "MailItem" Then
' ...
End If
End Sub

Call Outlook procedure using VBScript

I have a procedure in Outlook that sends all the saved messages in Drafts folder.
Below is the code:
Public Sub SendMail()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olDraft As Outlook.MAPIFolder
Dim strfoldername As String
Dim i As Integer
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
strfoldername = olFolder.Parent
Set olDraft = olNS.Folders(strfoldername).Folders("Drafts")
If olDraft.Items.Count <> 0 Then
For i = olDraft.Items.Count To 1 Step -1
olDraft.Items.Item(i).Send
Next
End If
End Sub
Above code works fine.
Question:
I want to use Task Scheduler to fire this procedure as a specified time.
1. Where will I put the procedure in Outlook, Module or ThisOutlookSession?
2. I am not good in vbscript so I also don't know how to code it to call the Outlook Procedure. I've done calling Excel Procedure but Outlook doesn't support .Run property.
So this doesn't work:
Dim olApp
Set olApp = CreateObject("Outlook.Application")
olApp.Run "ProcedureName"
Set olApp = Nothing
I've also read about the Session.Logon like this:
Dim olApp
Set olApp = CreateObject("Outlook.Application")
olApp.Session.Logon
olApp.ProcedureName
Set olApp = Nothing
But it throws up error saying object ProcedureName is not supported.
Hope somebody can shed some light.
SOLUTION:
Ok, I've figured out 2 work around to Avoid or get pass this pop-up.
1st one: is as KazJaw Pointed out.
Assuming you have another program (eg. Excel, VBScript) which includes sending of mail via Outlook in the procedure.
Instead of using .Send, just .Save the mail.
It will be saved in the Outlook's Draft folder.
Then using below code, send the draft which fires using Outlook Task Reminder.
Option Explicit
Private WithEvents my_reminder As Outlook.Reminders
Private Sub Application_Reminder(ByVal Item As Object)
Dim myitem As TaskItem
If Item.Class = olTask Then 'This works the same as the next line but i prefer it since it automatically provides you the different item classes.
'If TypeName(Item) = "TaskItem" Then
Set my_reminder = Outlook.Reminders
Set myitem = Item
If myitem.Subject = "Send Draft" Then
Call SendMail
End If
End If
End Sub
Private Sub my_reminder_BeforeReminderShow(Cancel As Boolean)
Cancel = True
Set my_reminder = Nothing
End Sub
Above code fires when Task Reminder shows with a subject "Send Draft".
But, we don't want it showing since the whole point is just to call the SendMail procedure.
So we added a procedure that Cancels the display of reminder which is of olTask class or TaskItem Type.
This requires that Outlook is running of course.
You can keep it running 24 hours as i did or, create a VBscript that opens it to be scheduled via Task Scheduler.
2nd one: is to use API to programatically click on Allow button when the security pop-up appears.
Credits to SiddarthRout for the help.
Here is the LINK which will help you programmatically click on the Allow button.
Of course you have to tweak it a bit.
Tried & Tested!
Assuming that you have Outlook Application always running (according to comment below your question) you can do what you need in the following steps:
add a new task in Outlook, set subject to: "run macro YourMacroName" and set time (plus cycles) when your macro should start.
go to VBA Editor, open ThisOutlookSession module and add the following code inside (plus see the comments inside the code):
Private Sub Application_Reminder(ByVal Item As Object)
If TypeName(Item) = "TaskItem" Then
Dim myItem As TaskItem
Set myItem = Item
If myItem.Subject = "run macro YourMacroName" Then
Call YourMacroName '...your macro name here
End If
End If
End Sub
Where will I put the procedure in Outlook, Module or ThisOutlookSession?
Neither. Paste the below code in a Text File and save it as a .VBS file. Then call this VBS file from the Task Scheduler as shown HERE
Dim olApp, olNS, olFolder, olDraft, strfoldername, i
Set olApp = GetObject(, "Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(6)
strfoldername = olFolder.Parent
Set olDraft = olNS.Folders(strfoldername).Folders("Drafts")
If olDraft.Items.Count <> 0 Then
For i = olDraft.Items.Count To 1 Step -1
olDraft.Items.Item(i).Send
Next
End If
If you are using Outlook 2007 or newer I have found you can easily eliminate the security pop up you mentioned above when running your script by doing the following:
In Outlook 2007 Trust Center, go to Macro Security - Select "No security Check for macros"
In Outlook 2007 Trust Center, go to Programatic Access - Select "Never warn me abous suspicious activity.
Of course that technically leaves you open to the remote possibility for someone to email you some malicious email script or something of that nature I assume. I trust my company has that managed though and this works for me. I can use VBS scripts in Outlook, Access, Excel to send emails with no security pop up.
Another Option:
If you don't want to do that, another option that has worked well for me prior to this is here:
http://www.dimastr.com/redemption/objects.htm
Basically a dll redirect that does not include the popup. It leaves your other default security in place and you write \ call your VBA for it and send mail without the secutity pop-ups.