My code looks like this:
Public WithEvents myItem As Outlook.MailItem
Private Sub Application_ItemLoad(ByVal Item As Object)
If Item.Class = olMail Then
Set myItem = Item
End If
End Sub
Private Sub myItem_Open(Cancel As Boolean)
Dim oAccount As Outlook.Explorer
Dim oMail As MailItem
Dim Recip As Outlook.Recipient
Set oAccount = Application.ActiveExplorer
MsgBox (oAccount.CurrentFolder.Store)
If oAccount.CurrentFolder.Store = "1#2.com" Then
MsgBox ("CC needs to be added")
Set Recip = myItem.Recipients.Add("user#test.com")
Recip.Type = olBCC
Else
MsgBox ("no need to add CC")
End If
End Sub
The part responsible for adding user#test.com to the CC field is adding that address to the "To:" field instead.
i just had to add Recip.Resolve after Recip.Type = olCC. That solved the issue.
Related
I am trying to auto forward an email from a specific sender and with a specific subject to a list of new recipients.
When I create a Run a Script Rule, my script is not shown.
Add my script via VBA Editor
Rules > Manage Rules & Alerts > Run a script
Select Run a script action -> Can not Select my script (script not show)
Option Explicit
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
Dim xStr1 As String
Dim xStr2 As String
If TypeOf Item Is MailItem Then
Set objMail = Item
If (objMail.SenderEmailAddress = "T#com") And (objMail.Subject = "ZZZZZ") Then
Set objForward = objMail.Forward
GoTo commonOutput
End If
End If
Exit Sub
commonOutput:
With objForward
.HTMLBody = xStr1 & xStr2 & Item.HTMLBody
.Display
End With
Release:
Set myFwd = Nothing
End Sub
VBA script which can be assigned to a rule should have the following signature:
Public Sub Test(item as object)
' your code
End Sub
Your existing code does almost the same without rules. It handles the ItemAdd event for the Inbox folder, so you just need to replace the Display method call with Send:
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objForward As Outlook.MailItem
Dim xStr1 As String
Dim xStr2 As String
If TypeOf Item Is MailItem Then
Set objMail = Item
If (objMail.SenderEmailAddress = "T#com") And (objMail.Subject = "ZZZZZ") Then
Set objForward = objMail.Forward
GoTo commonOutput
End If
End If
Exit Sub
commonOutput:
With objForward
.HTMLBody = xStr1 & xStr2 & Item.HTMLBody
.Send
End With
Release:
Set myFwd = Nothing
End Sub
I'm attempting to move email with specific subject when received.
The mail is still in my Inbox. I've tested by sending mail from my account with specific subject.
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Set myInbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
If TypeName(item) = "MailItem" Then
Set Msg = item
If InStr(0, Msg.Subject, "Testing Subject", vbTextCompare) > 0 Then
Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("Testing")
Msg.Move fldr
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
I created this macro in ThisOutlookSession.
I think you may have an error with the naming of your Sub which means it doesn't fire
Items_ItemAdd => inboxItems_ItemAdd
As an addendum: I recently implemented a RegEx filter to incoming e-mails as I found I couldn't easily use rules to filter out some junk e-mail coming my way. This should be able to adapted to your needs (I've added the rule I think should work for you, but it's untested)
Within the 'ThisOutlookSession'
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
On Error Resume Next
Call RegExFilterRules(EntryIDCollection)
End Sub
Within a module
Sub RegExFilterRules(ItemID As String)
' Requires Reference: Microsoft Scripting Runtime
Dim ThisNamespace As Outlook.NameSpace: Set ThisNamespace = Application.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder: Set Inbox = ThisNamespace.GetDefaultFolder(olFolderInbox)
Dim Junk As Outlook.MAPIFolder: Set Junk = ThisNamespace.GetDefaultFolder(olFolderJunk)
Dim oMsg As Outlook.MailItem: Set oMsg = ThisNamespace.GetItemFromID(ItemID, Inbox.StoreID)
If Not oMsg Is Nothing And oMsg.Class = olMail Then
'If FindPattern(oMsg.Subject, "^M\d+$") Then oMsg.Move Junk ' oMsg.Delete
If FindPattern(oMsg.Subject, "^Testing Subject") Then oMsg.Move Inbox.Folders("Testing")
End If
End Sub
Private Function FindPattern(Str As String, Pattern As String) As Boolean
Dim RegEx As Object: Set RegEx = CreateObject("vbscript.RegExp")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = Pattern
FindPattern = .Test(Str)
End With
End Function
I have code that moves an email to a folder and mark it as read when I assign a category to the email.
The code actually works, in that it does what I want it to do, with the exception of throwing this error.
When I debug it shows the following
Private WithEvents objInboxFolder As Outlook.Folder
Private WithEvents objInboxItems As Outlook.Items
'Process inbox mails
Private Sub Application_Startup()
Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set objInboxItems = objInboxFolder.Items
End Sub
'Occurs when changing item
Private Sub objInboxItems_ItemChange(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objTargetFolder As Outlook.Folder
If TypeOf Item Is MailItem And Item.Categories <> "" Then
Set objMail = Item
'Move mails based on color category
If InStr(objMail.Categories, "Personal") > 0 Then
Set objTargetFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Personal")
objMail.Move objTargetFolder
Else
objMail.UnRead = False
objMail.Save
Set objTargetFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("01 Actioned")
objMail.Move objTargetFolder
End If
End If
End Sub
Consider If TypeOf Item Is MailItem And Item.Categories <> "".
VBA evaluates every term of a Boolean expression before combining them to get the final result. It does not check TypeOf Item Is MailItem and only continue if Item is a MailItem. If Item is not a MailItem, Item.Categories will fail.
Try:
If TypeOf Item Is MailItem Then
If Item.Categories <> ""
. . . .
End If
End If
My code:
Public WithEvents myItem As Outlook.MailItem
Private Sub Application_ItemLoad(ByVal Item As Object)
If Item.Class = olMail Then
Set myItem = Item
End If
End Sub
Private Sub myItem_Open(Cancel As Boolean)
Dim oAccount As Outlook.Explorer
Dim oMail As MailItem
Dim Recip As Outlook.Recipient
Set oAccount = Application.ActiveExplorer
MsgBox (oAccount.CurrentFolder.Store)
If oAccount.CurrentFolder.Store = "account#outlook.com" Then
MsgBox ("CC needs to be added")
Set Recip = myItem.Recipients.Add("cc#cc.cc")
Recip.Type = olCC
Recip.Resolve
Else
MsgBox ("no need to add CC")
End If
End Sub
I would like to add something like myItem.SentOnBehalfOfName = "sent#behalf.com" into my code. Pasting it into my code does not work. I probably have to set something before.
I tried myItem.SentOnBehalfOfName = "sent#behalf.com" but it does not do anything. It does not show any errors.
This tricky SentOnBehalfOfName behaviour is described in previous posts.
Private Sub myItem_Open_SentonBehalf_Test()
Dim oExpl As Explorer
Dim myItem As mailitem
Set oExpl = ActiveExplorer
Set myItem = CreateItem(olMailItem)
' Do not display
If oExpl.CurrentFolder.store = "account#outlook.com" Then
Debug.Print "myItem.SentOnBehalfOfName:" & "x " & myItem.SentOnBehalfOfName & " x"
myItem.SentOnBehalfOfName = "sent#behalf.com"
Debug.Print "myItem.SentOnBehalfOfName:" & "x " & myItem.SentOnBehalfOfName & " x"
' be careful to put this after updating SentOnBehalfOfName
myItem.Display
' Manually display the From field to see the updated entry
Else
Debug.Print "Wrong path."
End If
ExitRoutine:
Set myItem = Nothing
Set oExpl = Nothing
End Sub
I'm trying to change the email address in Send To field in Outlook when the user press send button. for example , if the current Item.To value = 'aaa#example.com' it becomes 'bbb#example.com'.
I can change the subject , but failed with Item.To ( is it security issue ? ) :
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If Item.Class <> olMail Then Exit Sub
Item.To = "bbb#example.com" ' Nope , It does not work
Item.Subject = "New Subject" ' It works
End Sub
Thanks
The MailItem.To property is used only for display names. You probably want to use the Recipients collection as in this slightly modified example from Outlook's Help on the MailItem.Recipients property:
Sub CreateStatusReportToBoss()
Dim myItem As Outlook.MailItem
Dim myRecipient As Outlook.Recipient
Set myItem = Application.CreateItem(olMailItem)
Set myRecipient = myItem.Recipients.Add("bbb#example.com")
myItem.Subject = "New Subject"
myItem.Display
End Sub
I'm the question owner. I chose #joeschwa answer but also I want to display my code that cancel the current message and create new one ( you can change the recipients , message contents and anything else ) :
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If Item.Class <> olMail Then Exit Sub
Dim newEm As String
Dim Rec As Recipient
Dim myItem As Outlook.MailItem
Dim myRecipient As Outlook.Recipient
Set myItem = Application.CreateItem(olMailItem)
myItem.Body = Item.Body
myItem.HTMLBody = Item.HTMLBody
myItem.Subject = Item.Subject & " RASEEL PLUGIN "
Cancel = True
For Each Rec In Item.Recipients
If InStr(1, Rec.AddressEntry, "#example.com", vbTextCompare) Then
newEm = "example#example.net"
Else
newEm = Rec.AddressEntry
End If
Set myRecipient = myItem.Recipients.Add(newEm)
myRecipient.Type = Rec.Type
Next
myItem.Send
End Sub
It works for me. However, when changing recipient, it is also necessary first to delete the previous recipient. For example,
x = .recipients.count
if x = 1 then .recipients(1).delete
.recipients.add "abc#dfg.com"