I receive mails, from two senders, with two subjects, to a specific address.
I set up a rule:
from: example#example.com or example2#example2.com
sent to: me#me.com
and with: Company return doc or Daily document Country in the subject
except if the subject contains "FW:"
to run a script:
Sub myRuleMacro(Item As Outlook.MailItem)
Dim selEmail As Outlook.MailItem
Set selEmail = ActiveExplorer.Selection.Item(1).Forward
selEmail.Recipients.Add "address#address.pl"
selEmail.Send
Set selEmail = Nothing
End Sub
The script works for the selected email but to select it I need to click it manually, or if any other email is already clicked/marked it forwards this marked email, not the one from the rule.
How to choose the mail from the rule to trigger the macro?
Basically I need the solution which will forward the email. I cannot use the forwarding rule due to company safety policies.
You all most got it, it should be
Example
Option Explicit
Public Sub myRuleMacro(Item As Outlook.MailItem)
Dim selEmail As Outlook.MailItem
If TypeOf Item Is Outlook.MailItem Then
Set selEmail = Item.Forward
selEmail.Subject = Item.Subject
selEmail.HTMLBody = Item.HTMLBody
selEmail.Recipients.Add "address#address.pl"
selEmail.Save
selEmail.Send
End If
End Sub
No need for Selection.Item and make sure to save it before sending it
The email that the rule is triggered on is already being passed to the sub Item as Outlook.MailItem -- Sub myRuleMacro(**Item As Outlook.MailItem**)
You're not using this provided item and selecting a DIFFERENT item when you use Set selEmail = ActiveExplorer.Selection.Item(1).Forward
You should be able to simply use Item.Forward
Try
Sub myRuleMacro(Item As Outlook.MailItem)
Dim newForward as MailItem
Set newForward = Item.Forward
newForward.Recipients.Add "address#address.pl"
newForward.Send
End Sub
EDITED: To include updates by #Tony Dallimore in comments.
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.
I have a custom form in my appointment in which I have a CommandButton and a BCC field.
When the user press my commandButton, I want to add a mail to my BCC field.
Currently I have the following:
Sub CommandButton1_Click()
Set test = Item.Recipients.Add('alice#yahoo.com')
test = (int)Outlook.OlMailRecipientType.olBCC;
Item.Recipients.ResolveAll();
End Sub
I have tried a couple of different things, without any luck.
Thus far, I have only managed to add a standard Recipient, I.e.
Sub CommandButton1_Click()
Set oMsg = Application.ActiveInspector.CurrentItem
With oMsg
.Recipients.Add("test")
End With
End Sub
But it seems to be more convoluted to add a BCC mail
Therefore, how do I add a mail to my BCC field on commandbutton click?
Try this syntax to set the Type property of the recipient, and then resolve all.
Sub CommandButton1_Click()
Set test = Item.Recipients.Add("alice#yahoo.com")
test.Type = olBCC
Item.Recipients.ResolveAll()
End Sub
In your method you're trying to set the Item as an integer (cast from the BCC type), instead of setting the Type property OF the Item
It looks like you just need to modify the Recipients collection of the item:
Sub CommandButton1_Click()
Dim recip as Outlook.Recipient
Set recip = Item.Recipients.Add('alice#yahoo.com')
recip.Type = Outlook.OlMailRecipientType.olBCC;
Item.Recipients.ResolveAll();
End Sub
Note, the MeetingItem recipient can be one of the following OlMeetingRecipientType constants: olOptional, olOrganizer, olRequired, or olResource.
Most probably you will have to create a new MailItem and send it out separately as BCC.
For some reason, the Item.Recipients.ResolveAll() method did not work. Therefore, I skipped writing to a variable, and instead concatenated the type to .Recipients.Add().
Function CommandButton1_Click()
Set oMsg = Application.ActiveInspector.CurrentItem
With oMsg
.Recipients.Add(Mail).Type = 3
End With
End Function
The following works, and can be repeated with multiple recipients.
I am working for the VBA Macros of Outlook 2010 to filter and categorize incoming emails into different folders. The rule is mentioned in the target
When it comes to the implementation and testing, it does prompting error messages boxes instead of successful filtering. Would you please tell me what section under default call Application_NewMail shall proceed ?
Target :
extract words within [this Bracket]
Subject : [ABC] --> create inbox folder ABC
Subject : [CMX] --> create inbox folder ABC
Subject : CMX --> create inbox folder CMX
Subject : INC000000156156 --> create inbox folder INC and sub-folder INC000000156156
Programming Language : VBA Macro
Outlook Version : 2010
Here is my code and I have no clue on how to create folders if empty and assign email to the folder :
Private Sub Application_NewMail()
Dim olFld As Outlook.MAPIFolder
Set olFld = Outlook.Session.GetDefaultFolder(olFolderInbox)
olFld.Items.Sort "[ReceivedTime]", False
Dim olMail As Outlook.MailItem
Set olMail = olFld.Items.GetFirst
MyNiftyFilter olMail
End Sub
Private Sub MyNiftyFilter(Item As Outlook.MailItem)
Debug.Print Item
Debug.Print Item.Subject
Dim Matches As Variant
Dim RegExp As New VBScript_RegExp_55.RegExp
Dim Pattern As String
Dim Email_Subject As String
Pattern = "(([\w-\s]*)\s*)"
Email_Subject = Item.Subject
With RegExp
.Global = False
.Pattern = Pattern
.IgnoreCase = True
Set Matches = .Execute(Email_Subject)
End With
If Matches.Count > 0 Then
End If
Set RegExp = Nothing
Set Matches = Nothing
Set Item = Nothing
End Sub
You either use ItemAdd event https://stackoverflow.com/a/58428753/4539709 or fix your NewMail to simply
Private Sub Application_NewMail()
Dim Item As Outlook.MailItem
MyNiftyFilter Item
End Sub
The NewMail event fires when new messages arrive in the Inbox and before client rule processing occurs. If you want to process items that arrive in the Inbox, consider using the ItemAdd event on the collection of items in the Inbox. The ItemAdd event passes a reference to each item that is added to a folder.
You Application_NewMail() sub declares but never initializes the Item variable. Use NewMailEx event instead -it passes the new message entry id, whcih you can use to call Application.Session.GetItemFromID.
I am trying to change incoming emails subject line to only the last 11 characters of the subject line. When I use Item.Subject = Right(Item.Subject,11) it does not work.
Can someone assist?
Full code.
Sub ChangeSubjectForward(Item As Outlook.MailItem)
Item.Subject = Right(Item.Subject, 11)
Item.Save
End Sub
You could create a macro rule then run the below code:
Sub save_to_dir_test1(mymail As MailItem)
Dim strID As String
Dim objMail As Outlook.MailItem
strID = mymail.EntryID
Set objMail = Application.Session.GetItemFromID(strID)
objMail.Subject = Right(m.Subject, 11)
objMail.Save
Set objMail = Nothing
End Sub
For more information, please refer to this link:
Run a Script Rule: Change Subject then Forward Message
Getting the incoming email in outlook via VBA
I found another SO thread that says you can't modify the subject of a message without opening it first. We can use ActiveInspector to get a handle on the Item after we display it. Then we can change it, save it, and close it. I added a check to see if the subject is actually longer than 11 characters before we attempt to truncate it.
Try this:
Public Sub ChangeSubjectForward(ByRef Item As Outlook.MailItem)
Debug.Print Now ' This shows you when the code runs
If Len(Item.Subject) > 11 Then
Debug.Print "Subject is too long. Trimming..." ' This shows that we tried to truncate.
Item.Display 'Force the pop-up
Dim thisInspector As Inspector
Set thisInspector = Application.ActiveInspector
Set Item = thisInspector.CurrentItem ' Get the handle from the Inspector
Item.Subject = Right$(Item.Subject, 11)
Item.Save
Item.Close
End If
End Sub
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 4 years ago.
Improve this question
I have written a message handler function in Outlook's Visual Basic (we're using Outlook 2003 and Exchange Server) to help me sort out incoming email.
It is working for me, except sometimes the rule fails and Outlook deactivates it.
Then I turn the rule back on and manually run it on my Inbox to catch up. The rule spontaneously fails and deactivates several times a day.
I would love to fix this once and for all.
This code showed me the different TypeNames that were in my Inbox:
Public Sub GetTypeNamesInbox()
Dim myOlItems As Outlook.Items
Set myOlItems = application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
Dim msg As Object
For Each msg In myOlItems
Debug.Print TypeName(msg)
'emails are typename MailItem
'Meeting responses are typename MeetingItem
'Delivery receipts are typename ReportItem
Next msg
End Sub
HTH
I use the following VBA code snippet in other Office Applications, where the Outlook Library is directly referenced.
' Outlook Variables
Dim objOutlook As Outlook.Application: Set objOutlook = New Outlook.Application
Dim objNameSpace As Outlook.NameSpace: Set objNameSpace = objOutlook.GetNamespace("MAPI")
Dim objFolder As MAPIFolder: Set objFolder = objNameSpace.PickFolder()
Dim objMailItem As Outlook.MailItem
Dim iCounter As Integer: iCounter = objFolder.Items.Count
Dim i As Integer
For i = iCounter To 1 Step -1
If TypeOf objFolder.Items(i) Is MailItem Then
Set objMailItem = objFolder.Items(i)
With objMailItem
etc.
have written a message handler function in Outlook's Visual Basic (we're using Outlook 2003 and Exchange Server) to help me sort out incoming email. It is working for me, except sometimes the rule fails and Outlook deactivates it. Then I turn the rule back on and manually run it on my Inbox to catch up. The rule spontaneously fails and deactivates several times a day. I would love to fix this once and for all.
Here is the code stripped of the functionality, but giving you an idea of how it looks:
Public WithEvents myOlItems As Outlook.Items
Public Sub Application_Startup()
' Reference the items in the Inbox. Because myOlItems is declared
' "WithEvents" the ItemAdd event will fire below.
' Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
If TypeName(Item) = "MailItem" Then
MyMessageHandler Item
End If
End Sub
Public Sub MyMessageHandler(ByRef Item As MailItem)
Dim strSender As String
Dim strSubject As String
If TypeName(Item) <> "MailItem" Then
Exit Sub
End If
strSender = LCase(Item.SenderEmailAddress)
strSubject = Item.Subject
rem do stuff
rem do stuff
rem do stuff
End Sub
One error I get is "Type Mismatch" calling MyMessageHandler where VB complains that Item is not a MailItem. Okay, but TypeName(Item) returns "MailItem", so how come Item is not a MailItem?
Another one I get is where an email with an empty subject comes along. The line
strSubject = Item.Subject
gives me an error. I know Item.Subject should be blank, but why is that an error?
Thanks.
My memory is somewhat cloudy on this, but I believe that a MailItem is not a MailItem when it is something like a read receipt. (Unfortunately, the VBA code that demonstrated this was written at another job and isn't around now.)
I also had code written to process incoming messages, probably for the same reason you did (too many rules for Exchange, or rules too complex for the Rules Wizard), and seem to recall running into the same problem you have, that some items seemed to be from a different type even though I was catching them with something like what you wrote.
I'll see if I can produce a specific example if it will help.
There are many types of items that can be seen in the default Inbox.
In the called procedure, assign the incoming item to an Object type variable. Then use TypeOf or TypeName to determine if it is a MailItem. Only then should your code perform actions that apply to emails.
i.e.
Dim obj As Object
If TypeName(obj) = "MailItem" Then
' your code for mail items here
End If
Dim objInboxFolder As MAPIFolder
Dim oItem As MailItem
Set objInboxFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each Item In objInboxFolder.Items
If TypeName(Item) = "MailItem" Then
Set oItem = Item
next
why not use a simple error handler for the code? Seriously. You could write an error for each read of a property or object that seems to fail. Then have it Resume no matter what. No need for complex error handling. Think of a test that shows an empty subject. Since you don't know what value it will return, if any, and it seems to error on an empty or blank subject, you need to picture it as a simple test with a possible error. Run the test as an if statement (one in which you will get an error anyway), and have the program resume on error.
On Error Resume Next
If object.subject = Null 'produces an error when subject is null, otherwise allows a good read
strSubject = "" 'sets the subject grab string to a null or empty string as a string
Else
strSubject = object.subject 'Sets the subject grab string to the subject of the message\item
End If