Using VBA to read new Outlook Email? - vba

I have the following code which tells when new message has arrived!
Private Sub Application_NewMail()
MsgBox "New Mail Has Arrived"
End Sub
How do I read the body,subject of this mail? Are there any good tutorials for outlook programming?
I found msdn tutorial which was useful but was general overview.

You'll need something like this:
Private WithEvents myOlItems As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
MsgBox Msg.Subject
MsgBox Msg.Body
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Paste the code into ThisOutlookSession and restart Outlook. When a message enters your default local Inbox you'll see the popup with subject and body.

Related

How to apply WithEvents on newly received mail?

I'm trying to modify incoming emails in a specific folder and send it to another person.
The part modify/send works.
The script doesn't work when there is new email. It only works when I transfer it to myself.
The beginning of the code:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("DI").Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
Did you restart your Outlook? Please refer to the following code:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
Set Items = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Stuff").Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
MsgBox "You moved an item into the 'Stuff' folder."
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
Here is a link: VBA Outlook event moving email

VBA MailItem.Add only triggering once?

I have written a brief piece of code to perform certain actions when an e-mail arrives in the mailbox, but it only seems to work for the first e-mail that arrives immediately after the code is saved, after that nothing happens for subsequent e-mails.
I have put a watch on the code, and nothing is triggered, so it is not just a subsequent error in the subsequent code.
Code is (in the session object):
Option Explicit
Private objNS As Outlook.Namespace
Private WithEvents objItems As Outlook.Items
Private sub Application_Startup()
Dim objWatchFolder as Outlook.Folder
Set objNS = Application.Getnamespace("MAPI")
Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox)
Set objItems = objWatchFolder.Items
End Sub
Private Sub objItems_ItemAdd(ByVal Item as Object)
' Do this, that, the other, passing the e-mail to other subroutines
' No problems in this code.
End Sub
Any guidance or pointers that can be given would be greatly appreciated!
Please restart your Outlook if you use the WithEvents. However, please try to the following code:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' do something here
' ******************
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Reference link:How do I trigger a macro to run after a new mail is received in Outlook?

How do I PASS a SECOND Variable to run after a new mail is received in Outlook?

Private WithEvents Items As Outlook.Items
Public MyTrueFalse As Boolean
Private Sub Application_Startup()
Dim MyTrueFalse As Boolean 'Redundant?'
MyTrueFalse = True 'Defaults to False'
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object, ByVal MyTrueFalse As Boolean)
If MyTrueFalse Then GoTo DoThisAlso 'Example Only'
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' do something here
' ******************
End If
DoThisAlso:
MsgBox "MyTrueFalse is: " & MyTrueFalse
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
I am using the code above and its working wonderfully on the NEW EMAIL trigger (THANK YOU - Gautam Mainkar (LINK). However, I am trying to pass a Boolean (True/False) variable along with the Items event trigger.
So I am attempting to set say...MyTrueFalse within the Application_Startup() so it is set ONLY ONCE, and passed whenever Items_ItemAdd is triggered by a new email.
I do not want another sub routine, just pass MyTrueFalse boolean as set in the Application_Startup().
I have tried multiple variations of Public settings and multiple variables on the Items_ItemAdd sub and nothing works. I am hoping someone can help me here. Thanks
Oh Yeah: it resides in ThisOutlookSession
Private WithEvents Items As Outlook.Items
Private MyTrueFalse As Boolean
Private Sub Application_Startup()
MyTrueFalse = True
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
If MyTrueFalse Then GoTo DoThisAlso 'Example Only'
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' do something here
' ******************
End If
DoThisAlso:
MsgBox "MyTrueFalse is: " & MyTrueFalse
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Tim Williams was right, corrected the code (above) and works great!! Thanks Tim. Mike

Outlook Add Items quits working - Items_ItemAdd(ByVal Item As Object)

I am watching for new items and then calling a subroutine. In place of the subroutine, I am currently using a message box for testing.
Initially the code worked properly. After running it a few times, it quit working. If I shut down Outlook and reopened it would work again a few more times. I searched many sites for answers.
I tried backing up the project file, deleting it, restoring it. I was able to use this code again for awhile. Now I can't get it to work, regardless of what I do. I have been working on this for two days, but I cannot understand what is going wrong. I'm running Outlook 2010 and my code is posted below.
The code is saved in This Outlook Session:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("Access Data Collection Replies").Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' This is going to be the code to respond to the dealer and to call procedures. Maybe it can be handled with case statements. Then each event can be identified.
' ******************
MsgBox("It Worked!")
Call AnswerD
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
your code works find, if you are trying to get the msg box to pop then
Move this line code
MsgBox ("It Worked!")
next to
If TypeName(item) = "MailItem" Then
MsgBox ("It Worked!")
here is complete code tested on Outlook 2010
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNameSpace As Outlook.NameSpace
Set olNameSpace = Application.GetNamespace("MAPI")
'// ' Default local Inbox (olFolderInbox) & sub ("Folder Name")
Set Items = olNameSpace.GetDefaultFolder(olFolderInbox).Folders("Access Data Collection Replies").Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
If TypeOf item Is Outlook.MailItem Then
MsgBox ("It Worked!")
'AnswerD '<-- un-comment to call subroutine.
End If
End Sub
Private Sub SaveMovePrint(OlMail As Outlook.MailItem)
'On Error GoTo ErrorHandler
' ******************
' Here subroutine
' ******************
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

Forward email based on subject line

I'm trying to forward emails from my company's Outlook to an email account outside of our company. I have been given the ok to do this.
I'd like to forward any email that contains "Excel Friday" in the subject line.
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
Set Msg = Item
If Msg.Subject = "Excel Friday" Then
Dim myMail As Outlook.MailItem
Set myMail = Msg.Reply
myMail.To = "xxxxxx#fakemail.com"
myMail.Display
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
I'd like to forward any email that contains "Excel Friday" in the subject line to another email address.
But in the code you check for the exact match of the subject line:
If Msg.Subject = "Excel Friday" Then
Instead you need to look for a substring. To find the position of a substring in a string, use Instr function.
If Instr(Msg.Subject, "Excel Friday") Then
Also I have noticed that you use the Reply method:
Set myMail = Msg.Reply
Use the Forward method instead:
Set myMail = Msg.Forward
And then use the Send method.
myMail.Recipients.Add "Eugene Astafiev"
myMail.Send
Be aware, the code is based on the ItemAdd event handler. This event is not fired when a large number of items are added to the folder at once (more than 16).
You can do this using a Run a Script rule
Sub ChangeSubjectForward(Item As Outlook.MailItem)
Item.Subject = "Test"
Item.Save
Set olForward = Item.Forward
olForward.Recipients.Add "Jasonfish11#domain.com"
olForward.Send
End Sub
If a vba you can run on all messages in a folder at any time.
Paste into ThisOutlookSession and run
Sub ChangeSubjectThenSend()
Dim olApp As Outlook.Application
Dim aItem As Object
Set olApp = CreateObject("Outlook.Application")
Set mail = olApp.ActiveExplorer.CurrentFolder
For Each aItem In mail.Items
aItem.Subject = "New Subject"
aItem.Save
Set olForward = aItem.Forward
olForward.Recipients.Add "Jasonfish11#domain.com"
olForward.Send
Next aItem
End Sub
source Link