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
Related
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
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.
I came up with this to create an event listener for new emails to download attachments.
I combined How do I trigger a macro to run after a new mail is received in Outlook? with https://www.extendoffice.com/documents/outlook/3747-outlook-auto-download-save-attachments-to-folder.html
I cannot create a rule with macros in Outlook and I am unable to edit the registry on my current computer, so I need a workaround.
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
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
Dim strSubject As String
strSubject = Msg.Subject
If InStr(0, strSubject, "VBA Test") > 0 Then
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "F:\Jason - DataCopies"
For Each oAttachment In Msg.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
It seems you are interested in the NewMailEx event of the Application class. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example,MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item.
The NewMailEx event fires when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item. Use this method with caution to minimize the impact on Outlook performance. However, depending on the setup on the client computer, after a new message arrives in the Inbox, processes like spam filtering and client rules that move the new message from the Inbox to another folder can occur asynchronously.
Dim mail as Object
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Set mail = Application.GetNamespace("MAPI").GetItemFromID(EntryIDCollection)
End Sub
Another possible way is to hook up to the ItemAdd event of the Inbox folder:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Set Items = Inbox.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Example Item ' call sub
End If
End Sub
Public Sub Example(ByVal Item As Object)
Debug.Print Item.Subject
End Sub
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")
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