Could anyone guide me in creating an Outlook Macro that does the following:
Whenever I send a mail to a particular mail-id an automated mail will be send to a specified group pa mail-ids or some outlook contacts group.
Thanks in advance!!
Here is a quick piece of VBA for you to get going with, add it in your ThisOutlookSession module.
you should be able to do the CC via a rule as well from the tools menu, or write the code to create a rule !
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If Item.MessageClass = "IPM.Note" Then
For Each myRecipient In Item.Recipients
If myRecipient.Address = "<EMAIL ADDRESS TO FIND>" Then
''SendNotification
SendNotificationWithCopy Item
End If
Next
End If
End Sub
Sub SendNotification()
Set objMail = Application.CreateItem(olMailItem)
objMail.Recipients.Add "<EMAIL ADDRESS/GROUP TO SEND NOTIFICATION>"
objMail.Recipients.ResolveAll
objMail.Subject = "NOTIFICATION"
objMail.Body = "Body Text"
objMail.Send
End Sub
Sub SendNotificationWithCopy(obj As Object)
Set objMail = Application.CreateItem(olMailItem)
objMail.Recipients.Add "<EMAIL ADDRESS TO SEND NOTIFICATION>"
objMail.Recipients.ResolveAll
objMail.Attachments.Add obj, OlAttachmentType.olEmbeddeditem
objMail.Subject = "NOTIFICATION with attachment"
objMail.Body = "Body Text"
objMail.Send
End Sub
Related
I have been tasked to create an automated report system where an report from Google Data Studios are uploaded to specific projects (On a site called Basecamp). The reports always include both a report within the body of the e-mail and an attached PDF file. The are sent to a Gmail account (data studios refuse to schedule towards a non-Google account). The filters within Gmail doesnt really work well with the Basecamp system so I use filters to re-route them towards a Outlook account. There I use rules to send each e-mail towards the correct client within Basecamp.
Here comes the problem, Basecamp shows both the body of the e-mail AND the attached PDF version which makes us show duplicates.
Is there a way to create a macro that first deletes all attachments (or body of an e-mail) and THEN forward the e-mail.
It cant be done manually it have to be a rule that does it automaticaly. Keep in mind that I am not a coder and have never done anything like this so please keep it simple for my dumb brain!
Thank you in advance!
Marcus
PS: I found a code that seems to be what I am after.
Public WithEvents ReceivedItems As Outlook.Items
Private Sub Application_Startup()
Set ReceivedItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub ReceivedItems_ItemAdd(ByVal Item As Object)
Dim xForwardMail As Outlook.MailItem
Dim xEmail As MailItem
On Error Resume Next
If Item.Class <> olMail Then Exit Sub
Set xEmail = Item
If InStrRev(UCase(xEmail.Subject), UCase("kto feature")) = 0 Then Exit Sub 'change subject text to your need
If xEmail.Attachments.Count = 0 Then Exit Sub
Set xForwardMail = xEmail.Forward
With xForwardMail
.HTMLBody = ""
With .Recipients
.Add "skyyang#addin88.com" 'change address to your own
.ResolveAll
End With
.Send
End With
End Sub
I am trying to get that code to work, and changes the subject to a specific word and then route it to a final e-mail account that then filters out to correct clients. However the code doesnt seem to work, it DOES forward the e-mail but the attachment is still there. The code was found at https://www.extendoffice.com/documents/outlook/5359-outlook-forward-attachment-only.html#a1
It seems you need to modify the code slightly:
Public WithEvents ReceivedItems As Outlook.Items
Private Sub Application_Startup()
Set ReceivedItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub ReceivedItems_ItemAdd(ByVal Item As Object)
Dim xForwardMail As Outlook.MailItem
Dim xEmail As MailItem
Dim myattachments as Outlook.Attachments
On Error Resume Next
If Item.Class <> olMail Then Exit Sub
Set xEmail = Item
If InStrRev(UCase(xEmail.Subject), UCase("kto feature")) = 0 Then Exit Sub 'change subject text to your need
If xEmail.Attachments.Count = 0 Then Exit Sub
Set xForwardMail = xEmail.Forward
Set myattachments = xForwardMail.Attachments
While myattachments.Count > 0
myattachments.Remove 1
Wend
With xForwardMail
.HTMLBody = ""
With .Recipients
.Add "skyyang#addin88.com" 'change address to your own
.ResolveAll
End With
.Send
End With
End Sub
The Remove method of the Attachments class removes an object from the collection.
My task is to send an email containing a report and send another email containing another report to the same email thread by way of replying/forwarding to the sent email (excluding some recipients).
Option Explicit
Sub TestReply()
Dim objApp As Application
Dim objNewMail As Outlook.MailItem
Dim objReply As Outlook.MailItem
Set objApp = Outlook.Application
Set objNewMail = objApp.CreateItem(0)
' Outgoing email
With objNewMail
.Subject = "Test sending email"
.To = "abc#abc.com"
.HTMLBody = "This is the outgoing email."
.Send
End With
' Reply email
Set objReply = objNewMail.ReplyAll
With objReply
.HTMLBody = "This is the reply emal."
.Display
End With
Set objApp = Nothing
Set objNewMail = Nothing
Set objReply = Nothing
End Sub
I can't find a way to send the follow up email (either by reply or forward).
When I try the above code, it says error the item is moved/deleted. I guess it is becaused when the email is sent, the objNewMail odject is also terminated.
I tried adding RE: or FW: to the subject of the original email but then the two emails will not be in the same thread but independent emails.
An additional problem is that I have two email accounts in Outlook: my own email and team email and the reports are to be sent from the team email.
You can determine if an item added to the sent folder matches objNewMail.
In ThisOutlookSession
Option Explicit
Private WithEvents sentFolderItems As Items
Private Sub Application_Startup()
'Set sentFolderItems = Session.GetDefaultFolder(olFolderSentMail).Items
' Reference any folder by walking the folder tree
' assuming the team folder is in the navigation pane
Set sentFolderItems = Session.folders("team mailbox name").folders("Sent").Items
End Sub
Private Sub sentFolderItems_ItemAdd(ByVal Item As Object)
Dim myReplyAll As MailItem
If Item.Class = olMail Then
'do not use InStr unless you change some part of words in original subject
' or another reply will be generated
If Item.Subject = "Test sending email" Then
Set myReplyAll = Item.ReplyAll
With myReplyAll
.HTMLBody = "This is the reply email."
.Display
End With
End If
End If
End Sub
Sub TestReply()
Dim objNewMail As MailItem
'Set objNewMail = CreateItem(olMailItem)
' Add, not create, in non-default folder
Set objNewMail = Session.folders("team mailbox name").folders("Inbox").Items.Add
' Outgoing email
With objNewMail
.Subject = "Test sending email"
.To = "abc#abc.com"
.HTMLBody = "This is the outgoing email."
.Send
End With
End Sub
Note: Application. and Outlook. are not needed when code is in Outlook.
Call Send on the original email (objNewMail) only after you construct the reply.
Right so currently your code is doing this:
Creating a mail, sending it.
Trying to reply to the mailitem object which is already sent.
What you need is an event Hook to catch the mail when it's received by yourself. (assuming this is how you're reply all and removing some recipients for report 2)
Here is how you accomplish this:
First Create a WithEvents as Items call AllMyItems, then a hook in the AllMyItems_ItemAdd, then initialize the event when Outlook Starts using Application_Startup (a built in event)
Be very careful to identify criteria for forwarding / actioning the incoming mail item, since this event code will scan every mail sent to your main inbox and evaluate it. IF you want to further reduce the risk of forwarding a mail item to the wrong person, consider using an outlook rule to sort it into a custom folder, and then setting that folder's location as the Set AllMyItems = line instead of default folder
Option Explicit
'for the Default DL inbox
Private WithEvents AllMyItems As 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
'all my items in the main box
Set AllMyItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set olapp = Nothing
Set objNS = Nothing
End Sub
Private Sub AllMyItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
If TypeName(Item) <> "Mailitem" Then
If TypeName(Item) = "ReportItem" Then GoTo 0 'undeliverables shows as a report item
If TypeName(Item) = "MeetingItem" Then GoTo 0
Dim oItem As MailItem
Dim myForward As MailItem
Set oItem = Item
'use the next line to check for a property of the incoming mail, that distinguishes it from other mail, since this event will run on every mail item
If InStr(1, oItem.Subject, "Your public folder is almost full", vbTextCompare) > 0 Then
Set myForward = oItem.Forward
myForward.Recipients.Add "derp#derpinacorp.com"
myForward.Importance = olImportanceHigh
'MsgBox "uno momento"
myForward.Send
Else
End If
Else
End If
0:
End Sub
We have Outlook 2013 which now comes with Custom Form Script disabled and we can't re-enable it (company policy). Normal VBA works fine.
I need to send an email when a task is marked as complete. How can I get notified when the task is marked complete so I can send the email? I can use any of the standard Application Events, but none seem to help me. Thanks.
You can use Items.ItemChange event on the Tasks folder (whcih can be retrieved using Application.Session.GetDefaultFolder(olFolderTasks)).
Having used the guidance that Dmitry Streblechenko gave, this is the code that works. Posting for completeness.
Public WithEvents myOlItems As Outlook.Items
Public Sub Initialize_handler()
Set myOlItems = Application.Session.GetDefaultFolder(olFolderTasks).Items
End Sub
Private Sub myOlItems_ItemChange(ByVal Item As Object)
' https://learn.microsoft.com/en-us/office/vba/api/outlook.taskitem
If Item.Class = olTask Then
If Item.Complete Then
'Creates a new email item and modifies its properties
Dim objMail As Outlook.mailItem
Set objMail = Application.CreateItem(olMailItem)
With objMail
.BodyFormat = olFormatHTML
.To = ""
.CC = ""
.HTMLBody = "Stuff"
.Display
End With
End If
End If
End Sub
Hope that helps others wanting to do the same.
I want to delete an email from the Sent Items folder after the email is forwarded with a rule.
I tried to use "brettdj" code from another post:Macro to delete an email but it's not working for me at all .
what I'm looking for it's a vba macro that can delete an email when you run the script with the rule.
any idea how I can accomplished that
thanks in advance
You don't have a corresponding entry in your contacts folder (address book). The Add method of the Recipients class accepts the name of the recipient; it can be a string representing the display name, the alias, or the full SMTP e-mail address of the recipient.
Sub forwardEmail(itm As Outlook.MailItem)
Dim oExplorer As Outlook.Explorer
Dim oMail As Outlook.MailItem
Dim oOldMail As Outlook.MailItem
Set oExplorer = Application.ActiveExplorer
If oExplorer.Selection.Item(1).Class = olMail Then
Set oOldMail = oExplorer.Selection.Item(1)
Set oMail = oOldMail.Forward
oMail.Recipients.Add "test#gmail.com"
oMail.Recipients.Item(1).Resolve
If oMail.Recipients.Item(1).Resolved Then
'delete forwarded email from sent items
oMail.DeleteAfterSubmit = True
oMail.Send
'delete original email from inbox
'oOldMail.Delete
Else
MsgBox "Could not resolve " & oMail.Recipients.Item(1).Name
End If
Else
MsgBox "Not a mail item"
End If
End Sub
Newbie poster with Outlook VBA. Intermediate Excel VBA coder.
I have a VBA routine that autoforwards all incoming email to a Gmail account. It is not all my code, (modified from a blog post) but it works. I need to keep a copy of all my email received in all my accounts so I can consolidate them into one main one. In the Outlook 2010 Exchange account, all the forwarded mail gets saved in the SENT folder as a copy.
Is it possible to delete the autoforwarded copy in the SENT folder, without deleting all SENT emails? I need to keep the emails I actually respond to.
I would not have a problem using conversation mode in the INBOX, to store the replied to emails. but as it now stands, everything is duplicated due to the bcc copy in the SENT folder when I toggle Conversation mode for the INBOX.
Thanks in advance for any assistance.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objRecip As Recipient
Dim strMsg As String
Dim res As Integer
Dim strBcc As String
On Error Resume Next
' #### USER OPTIONS ####
' address for Bcc -- must be SMTP address or resolvable
' to a name in the address book
strBcc = "bcc.hwb#gmail.com"
Set objRecip = Item.Recipients.Add(strBcc)
objRecip.Type = olBCC
If Not objRecip.Resolve Then
strMsg = "Could not resolve the Bcc recipient. " & _
"Do you want still to send the message?"
res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
"Could Not Resolve Bcc Recipient")
If res = vbNo Then
Cancel = True
End If
End If
Set objRecip = Nothing
End Sub
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim varEntryIDs
Dim objItem
Dim myItem As MailItem
Dim i As Integer
varEntryIDs = Split(EntryIDCollection, ",")
For i = 0 To UBound(varEntryIDs)
Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
'MsgBox (varEntryIDs(i))
Set myItem = objItem.Forward
myItem.Recipients.Add "bcc.hwb#gmail.com"
myItem.Send
'myItem.Delete
Set myItem = Nothing
Next
End Sub
See MailItem.DeleteAfterSubmit Property (Outlook)
myItem.DeleteAfterSubmit = True