Here is the event code I promised for forwarding emails to another email address. It does exactly the same thing as the previous code, but since it is event code, once you place it in a class module and restart Outlook, it runs automatically without any need for you to run macros by hand.
Start by pasting the following into the ThisOutlookSession module:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
This code will set up the event handler. If you already have an Application_Startup event, simply copy and paste the inner code into it. Of course you'll want to check that you aren't duplicating any code; Option Explicit and a quick Debug>Compile will check for that.
The ItemAdd event will check any newly added items to the Inbox, and, if they meet the criteria we specify, a new mail item is created (via the Forward method) and sent to the email address of our choice. Then the original message is marked as read and neatly tucked away. Here is the complete code:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
If item.Class = olMail Then
If Left$(item.Subject, 16) = "String to search" Then
Dim Msg As Outlook.MailItem
Dim NewForward As Outlook.MailItem
Dim MyFolder As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Set Msg = item
Set NewForward = Msg.Forward
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set MyFolder = olNS.GetDefaultFolder(olFolderInbox).Folders(”Archive”)
With NewForward
.Subject = Right(Msg.Subject, Len(Msg.Subject) - InStrRev(Msg.Subject, " "))
.To = "myemail@mobiledevice.com"
.HTMLBody = ""
.Send
End With
With Msg
.UnRead = False
.FlagStatus = olNoFlag
.Move MyFolder
End With
End If
End If
ExitProc:
Set NewForward = Nothing
Set Msg = Nothing
Set olApp = Nothing
Set olNS = Nothing
Set MyFolder = Nothing
End Sub
Paste this into the ThisOutlookSession module, save and restart Outlook to get the code to start working.
I chose some arbitrary criteria (the first 16 characters of the Subject Line), you would need to customize this for your needs.
About JP
19 Comments:
Hi,
Just read your post on the blog and the code samples that you have put up for VBA Outlook look very good.
Can you guide me about writing code to delete duplicate emails from a selected folder?
Cheers
TG
Tarun,
Do you have any code written so far? Some of the code on the site can be rigged to do what you want. Just set an object reference to the folder like this:
Dim MyFolder As Outlook.MAPIFolder
Dim olNS As NameSpace
Set olNS = Application.GetNamespace("MAPI")
Set MyFolder = olNS.GetDefaultFolder(olFolderInbox).Folders("Folder To Search")
Then you would have to decide how you want to identify the emails, using the Sort method to line them up so they can be compared. Are the emails exactly the same?
Thx,
JP
Thanks for this little gem!
I just customised this to auto reply to anybody who sends me an email with a blank subject field and give them a bollocking!
Whatever floats your boat
I pasted it on the VBA module, but it doesn't work. WHat should I do?
Can you be more specific? Did you step through the code to see where it stops? If so, which line of code causes an error?
Hi JP,
Is it possible to make a macro code in outlook that will automatically set an appointment in the calendar, base on a particular email address?
For example: evrytime an email is address to abc@yahoo.com email it will automatically create an appointment in the calendar that says "response in 5 mins." If the user dismiss it it will pop again after 2 mins.
Is this possible? Thanks for your help!
Regards,
Cha
Sure, although a Task reminder is more appropriate (in my opinion). The ItemSend Event has a reference to the item being sent. You can use this event to check your outgoing messages. For example
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim msg As Outlook.MailItem Dim olapp As Outlook.Application Dim olns As Outlook.NameSpace Dim olcal As Outlook.Items Dim newTask As Outlook.TaskItem If TypeName(Item) = "MailItem" Then Set msg = Item If msg.To = "abc@yahoo.com" Then ' get default calendar Set olapp = Outlook.Application Set olns = olapp.GetNamespace("MAPI") Set olcal = olns.GetDefaultFolder(olFolderTasks).Items Set newTask = olcal.Add With newTask .Subject = "response in 5 mins" .ReminderSet = True .ReminderTime = Now + TimeValue("00:05:00″) .Save End With End If End If End SubSee http://www.jpsoftwaretech.com/outlook-vba/etiquette-check/ for more sample code.
Hi JP,
Thank you very much for your help!
I will try this in my outlook
Again, Thank you very much!!!
Regards,
Cha
Dear JP,
I tried the codes you suggested. These codes are for sending new mail.
These is what I need:
For example a person will send to the abcgroup@yahoo.com email(which is us)then it will automatically create a reminder in our outlook that we need to respond in 5 minutes and it will pop again after 2 minutes.
Please help.
Appreciate it very much!
Regards,
Cha
Cha,
See http://www.jpsoftwaretech.com/outlook-vba/automate-outlook/ for sample code.
JP,
I am wondering if this code can be expanded to parse an email message body before forwarding to another email.
I have a user who would like to auto-forward some emails that have "emergency" in the subject line to a pager. The problem is that the body has more info than the pager can handle, so she would like to edit or parse out the info that she needs and forward that on. The emails are pretty much formatted the same with different body info in the middle of the email that she wants to pull out. She would like it automated for the times that she is away on vacation, the emergency emails need to still be sent. Outlook rules wizard doesn't have an option for this.
I also have to admit that I am not too familiar with VB code, but can follow some code logic.
Any help with this would be greatly appreciated as I have searched google for something like it, but have come up short!
Thanks in advance!
Absolutely. Just change
to
As far as sending when on vacation, it depends on the environment. If you can set up server side rules, you can forward the emails even when the computer is off. You won't be able to use the VBA solution, however, because it resides on the local computer and the local computer would need to be on to receive the email and process it programmatically.
A lot of hardware devices have the ability to send SMS messages to network admins in case of trouble. You might want to talk to your admin to see if there's a better solution, because if it's a true emergency there's a way to do it.
Is it possible to monitor a number of folders for new emails, then forward to different mailboxes depending on which folder the newmail lands in?
Eg
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items + forward to a
Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("test") + forward to b
etc etc
New mail only lands in the Inbox folder of whatever location you specify in the email account settings. So you wouldn't need to set up more than one event handler.
Hi All,
I need Macro Coding such as
If I create any Mail or reply to any mails it should come asf
1st mail Dev/11/0001
2nd mail Dev/11/0002
Here Dev is my name 11 is Month and 1 is the mail number which will get increase automatically
If possible please assign any short cut keys for that as this may not require for all mails
Thank You in advance
Do you have any code written so far?
Nope dear
If you need something specific, feel free to ask. But I'm afraid I can't write the entire thing for you.