Autoforward email from specific folder - vba

I would like to create autoforward email in vba with condition :
Only mail from "sourcemail#gmail.com" and there is "ABCDE" in the body
Only mail from specific folder under inbox \ownmail#gmail.com\Inbox\Folder1
Condition 1 is no problem if mail is coming to "inbox", but condition 2 if it's coming into "Folder1" it's not autoforwarded.
My code is like this:
Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items
Private Sub Application_Startup()
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set objInboxItems = objInbox.Items
End Sub
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objForward As Outlook.MailItem
If TypeOf Item Is MailItem Then
Set objMail = Item
'If it is a specific new email
If (objMail.SenderEmailAddress = "sourcemail#gmail.com") And InStr(Item.Body, "ABCDE") > 0 Then
Set objForward = objMail.Forward
'Customize the forward subject, body and recipients
With objForward
.Subject = "test subject"
.HTMLBody = "<HTML><BODY>test body</BODY></HTML>" & objForward.HTMLBody
.Recipients.Add ("recepient1#gmail.com")
.Recipients.Add("recepient2#gmail.com").Type = olCC
.Recipients.ResolveAll
.Importance = olImportanceHigh
.Send
End With
End If
End If
End Sub

I believe that you are only checking for mail that gets directly to your inbox. To check if a mail that gets in Folder1 get forwarded, I think you have to do some similar as you did for your inbox, like this code:
' Inbox: Folder1
Public WithEvents InboxFolder1 As Outlook.Items
' Put this line in Sub Application_Startup. Correct the path if it's not this.
Set InboxFolder1 = objInbox.Folders.Item("ownmail#gmail.com").Folders.Item("Inbox").Folders.Item("Folder1").Items
' Create this procedure
Private Sub InboxFolder1_ItemAdd(ByVal Item As Object)
' Put your code in here
Debug.Print Item.Subject
End Sub

Related

Reference a Shared Sub Folder in an inbox

I'm looking to modify my VBA code to reference a shared inbox that has a subfolder inside of it. The commented out code worked with my main inbox folder and a sub folder called test. I've tried to use the getSharedDefaultfolder method but the code currently does not detect an email being placed in the subfolder of my shared inbox. Does anyone have any thoughts or recommendations?
Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Set olNs = Application.GetNamespace("MAPI")
Set shrdRecip = olNs.CreateRecipient(test#outlook.com)
Set Inbox = olNs.GetSharedDefaultFolder(shrdRecip, olFolderInbox).Folders("test")
'Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Folders("test")'
'Set objInboxItems = objInbox.Items'
Set objInboxItems = Inbox.Items
End Sub
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objForward As Outlook.MailItem
MsgBox Item.Subject
If TypeOf Item Is MailItem Then
Set objMail = Item
MsgBox objMail.UnRead
If (objMail.UnRead Or False) Then
Set objForward = objMail.Forward
With objForward
.Subject = "Custom Subject"
.HTMLBody = "<HTML><BODY>Type body here. </BODY></HTML>" & objForward.HTMLBody
.Recipients.Add (usr#yahoo.com)
.Recipients.ResolveAll
.Send
MsgBox Item.Subject
End With
End If
End If
End Sub
Sub MyTEST()
End Sub```
You need to add the shared folder/store to your Outlook profile if you want to get events fired in VBA.
Also make sure an instance of the Items class was initialized correctly in the code to get the events fired.
I'd suggest calling the Recipient.Resolve method before accessing the shared folder, it attempts to resolve a Recipient object against the Address Book.
Are you sure objInboxItems is not null? By default, GetSharedDefaultFolder only returns the folder but not its subfolders unless the shared mailbox is added to the profile as a delegate mailbox and and all its folders are synchronized by Outlook.

Get a specific Line in a body of email vba outlook

Every time the mail is received, I want to print out a specific word in a body of email:
---------------------------------Body of email-------------------------------------
Sender Name: John
Sender's Address: john#sample-mail.com
Subject: Mail Subject from John <----- the line that I want to get
--------------------------------------End------------------------------------------
My Code:
Private WithEvents olItems As Outlook.Items
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
End Sub
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox).Folders("Watchlisted").Items
End Sub
Private Sub olItems_ItemAdd(ByVal Item As Object)
Dim BodySubjLine As String, BodySubj As Variant
Dim olMail As Outlook.MailItem
Dim olAtt As Outlook.Attachment
Set olMail = Item
BodySubj = Split(olMail.Body, vbNewLine)
BodySubjLine = Trim(BodySubj(2))
Debug.Print BodySubjLine
Set olMail = Nothing
End Sub
Expected output:
Subject: Mail Subject from John
The output I get gives nothing at all
You could use breakpoints to debug the code.
Instead of
BodySubj = Split(olMail.Body, vbNewLine)
Use
BodySubj = Split(olMail.Body, Chr(10) & Chr(13))
Instead of relying on message body lines you can use regular expressions to extract the exact substrings, read more about that:
RegEx in Outlook VBA to get text from Email Body
Use RegEx to extract text from an Outlook email message

How to apply the ItemAdd event to a folder at the same level as the inbox?

I've been able to forward a message with custom text added when it hits my inbox.
I need messages from a folder other than my inbox to be forwarded.
I receive notifications from Box, and I've set up a routing for those messages to be directed to a "BoxNotifications" folder. That folder is at the same level as the Inbox.
I don't understand what needs to be done, even after searching extensively.
What would I need to get messages that enter the "BoxNotifications" folder to be forwarded with custom text?
Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items
Private Sub Application_Startup()
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set objInboxItems = objInbox.Items
End Sub
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objForward As Outlook.MailItem
If TypeOf Item Is MailItem Then
Set objMail = Item
'If it is a specific new email
If (objMail.SenderEmailAddress = "senderemail#gmail.com") And (objMail.Subject Like "*Test*") Then
Set objForward = objMail.Forward
'Customize the forward subject, body and recipients
With objForward
.Subject = "Testing Email"
.HTMLBody = "<HTML><BODY>Custom text added to top of email</BODY></HTML>" & objForward.HTMLBody
.Recipients.Add ("email_forwarded_to#email.com")
.Recipients.ResolveAll
.Importance = olImportanceHigh
.Send
End With
End If
End If
End Sub
Use Folder.Parent property (Outlook)
Example
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders("folder_name")

Replying to mails on a non-default mailbox

I have many mailboxes in Outlook. I have set-up the following code to process incoming mails on one of my non-default mailboxes (requests#address.com).
I want to process all mails arriving in this box, perform an action on the content, then ReplyAll to that mail.
The problem is that the ReplyAll only includes the mailbox itself as a recipient (requests#address.com) and not the sender. The result is that the sender does not get a response but that the box keeps sending and receiving by itself in a loop.
If there is more than one person cc'd in the original, they get a copy of the mail but not the sender himself.
When using ReplyAll, how can I get the mailbox to identify the sender as the recipient instead of the mailbox itself?
Option Explicit
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim olRecip As Recipient
Set olNs = Application.GetNamespace("MAPI")
Set olRecip = olNs.CreateRecipient("requests#address.com") '// Owner's Name or email address
Set Inbox = olNs.GetSharedDefaultFolder(olRecip, olFolderInbox)
Set Items = Inbox.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Debug.Print Item.Subject
Dim myReply As Outlook.MailItem
Set myReply = Item.ReplyAll
myReply.htmlbody = "Replied At: "& Now()
myReply.SentOnBehalfOfName = "requests#address.com"
myReply.Send
End If
End Sub
To ensure the sender is included in myReply, you could add Item.SenderEmailAddress to the myReply.To.
You could exit if Item.SenderEmailAddress is "requests#address.com".
Try this
Private Sub Items_ItemAdd(ByVal Item As Object)
Dim Recip As Recipient
If TypeOf Item Is Outlook.MailItem Then
Debug.Print Item.Subject
Set Item = Item.ReplyAll
Set Recip = olReply.Recipients.Add Item.SenderEmailAddress
Recip.Type = olTo
Item.HTMLBody = "Replied At: " & Now()
Item.display
End If
End Sub

Outlook run macro when mail arrives on a nondefault mailbox

I have multiple mailboxes set-up in my Outlook 2010. I would like a macro to run when I receive a mail on one of the non-default mailboxes.
I have coded the below and inserted the code into "ThisOutlookSession".
I have gotten it to work for the default mailbox's inbox but not my nondefault mailbox's inbox. When I try to re-open outlook 2010 having inserted the code, It tells me :
"Compile error in hidden module: ThisOutlookSession". The non-default box is called 'abc.asia'.
I am new to vba so any inputs are appreciated, thank you!
Dim WithEvents myInboxMailItem As Outlook Items
Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
MsgBox("Item Added")
End Sub
Private Sub Initialize_Handler()
Dim fldInbox As Outlook.MapiFolder
Dim gnspNameSpace As Outlook.NameSpace
Set gnspNameSpace = Outlook.GetNameSpace("Mapi")
Set fldInbox = gnspNameSpace.Folders("abc.asia").Folders("Inbox")
Set myInboxMailtItem = fldInbox.Items
End Sub
Update Set olRecip = olNs.CreateRecipient("emal#address.com") with correct Email address.
Option Explicit
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim olRecip As Recipient
Set olNs = Application.GetNamespace("MAPI")
Set olRecip = olNs.CreateRecipient("emal#address.com") '// Owner's Name or email address
Set Inbox = olNs.GetSharedDefaultFolder(olRecip, olFolderInbox)
Set Items = Inbox.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Debug.Print Item.Subject
End If
End Sub