I have a code which checks the subject in my e-mail and warns me if I already sent an email with this subject. I experienced it would be smarter if it checks for the email address.
I tried substituting "subject" with "recipients" but without success.
Public Sub Application_ItemSend(ByVal thisItem As Object, Cancel As Boolean)
Dim ns As Outlook.NameSpace
Dim olfolder As MAPIFolder
Dim Item As Object
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set firstFolder = olNs.Folders("test#dk.com") ' name of my shared inbox
Set olfolder = firstFolder.Folders("sent items")
' iterate thru emails
For Each Item In olfolder.Items
' check subject content & date difference
If InStr(Item.Subject, thisItem.Recipients) And DateDiff("m", Item.SentOn, Now) < 1 Then
' added this part
If MsgBox("already sent", vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Message Text Warning") = vbNo Then
' cancel the email
Cancel = True
End If
Exit For
End If
Just replace thisItem.Subject to thisItem.To
edit: Nathan_Sav said it all :) .Recipents property returns an array so you can loop through it, might as well use .To which will return all recipients separated by semicolon
edit2: note there are two other properties .cc and .bcc if you use them, whilst .Recipients array include all of them
Firstly, do not ever loop through all items in a folder - this is horribly inefficient. Use Items.Find with a restriction on the Subject and SentOn properties.
For the recipients, you can use a restriction on the To property, but keep in mind that on the MAPI level it translates to a restriction on the PR_DISPLAY_TO property, which may or may not include the actual email address. OOM does not create subrestrictions on the PR_MESSAGE_RECIPIENTS property. If using Redemption (I am its author) is an option, its version of RDOItems.Find/Restrict allows to specify Recipients, To, CC, BCC properties in a query and creates an appropriate restriction on the email address and name of the message recipients.
In the worst case you can restrict on the Subject and SentOn properties using Items.Find/FindNext or Items.Restrict, and then explicitly loop through the Recipients collection of the returned matches.
Related
Every day I get one or more spam emails of a very specific type to my xxxxx#gmail account.
They all have a garbled and unique FROM: email address.
The TO: and CC: fields are always of the form xxxxx[random chars]#aol.com. For example I got one today with
TO: xxxxx#aol.com
CC: xxxxxY7#aol.com
I would like to create a rule to automatically send these to spam and block. Two possible conditionals would be:
"with xxxxx AND #aol.com in recipient's address"
"with xxxxx*#aol.com in recipient's address" (with * as a wildcard).
#1 doesnt work because the "specific words" it requests are concatenated with OR, no option to use AND.
#2 doesn't work because as far as I can tell there is no way to use wildcards.
Any suggestions? I realize there probably is a straightforward VBA script solution but I haven't played with VBA in over a decade. Was hoping there might be another clever non-VBA work around. Thanks.
There is no workaround. You can handle incoming emails in Outlook VBA by handling 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. You can use the Entry ID from the EntryIDCollection parameter to call the NameSpace.GetItemFromID method and process the item.
In the NewMailEx event handler you can check the required properties such as Recipients and etc. and move the item wherever you need.
As stated, NewMailEx can be used to handle some filtering like this and I have a regex filter that I use as standard automatic rules don't allow that (or at least not currently - maybe a future upgrade). If you can use a regex to identify the e-mails you want to process then you could use this code:
In ThisOutlookSession
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
On Error Resume Next
Call RegExFilterRules(EntryIDCollection)
End Sub
In a module
Sub RegExFilterRules(ItemID As String)
With Application.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder: Set Inbox = .GetDefaultFolder(olFolderInbox)
Dim Junk As Outlook.MAPIFolder: Set Junk = .GetDefaultFolder(olFolderJunk)
Dim olItem As Outlook.MailItem: Set olItem = .GetItemFromID(ItemID, Inbox.StoreID)
End With
'On Error Resume Next
If Not olItem Is Nothing And olItem.Class = olMail Then
If IsPatternFound(olItem.subject, "^M\d+$") Then olItem.Move Junk 'olItem.Delete 'olItem.UnRead = False
If olItem.Sender = "cortana#microsoft.com" Then olItem.Delete
End If
Set olItem = Nothing
End Sub
Private Function IsPatternFound(Content As String, Pattern As String) As Boolean
' Requires Reference: Microsoft Scripting Runtime
Dim RegEx As Object: Set RegEx = CreateObject("vbscript.RegExp")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = Pattern
IsPatternFound = .Test(Content)
End With
End Function
I'd like to follow the status of an email as it passes through the phases and folders of its life cycle, through "Drafts", "Outbox", and "Sent".
Of related interest is the ability to access existing emails to gather property info, such as sent time.
I've started with the included block of code. The Do Loop fails the moment the email is sent, because the variable disconnects from the email.
This causes the runtime error
The item has been moved or deleted.
The error number (Err.Number) is different every time, and I wonder what the design purpose is.
How can I stay connected to sending emails as they move through Drafts, Outbox, and Sent?
I see many mentions of the variable disconnecting from the mailitem, but no solutions that rely on the object hierarchy and avoid late-binding to address the issue. I thought perhaps there would be a GUID or UUID that identifies the message, but as indicated in the documentation, all properties such as EntryID can change if the item is moved, and such properties should not be relied on.
With deeper examination, this makes sense because an email is just a record in a database table. And if you duplicate/delete records between tables, the info might be the same or similar, but the record number probably won't be.
Also, that hits other nails: the same email can be sent multiple times, and also can be copied/pasted into different folders, and even different accounts. Now what's unique or not?
Aside from staying "connected" to a email, what properties or techniques can be used to ID one?
If there's no "proper" way to identify a mailitem as described, about the only thing I can think of is to use an existing or custom field, like the "Tag" property of OCX controls, to insert a UUID. Some companies use this sort of technique by putting a call/order/support number in the subject line to make then easier to track.
Dim outlobj As Outlook.Application
Dim mailobj As Outlook.MailItem
Set outlobj = Outlook.Application
Set mailobj = outlobj.CreateItem(olMailItem)
With mailobj
.Recipients.Add "wonderwoman#hallofjustice.com"
.Subject = "Invisible Jet Scheduled Maintenance Reminder"
.Body = "Your invisible jet need to be polished."
.Attachments.Add zipFilename
.Display
.Send
End With
Do
'next line fails due to email moving through Drafts, Outbox, & Sent
'notably, the VBA runtime Err.Num is different each time
'how do i keep the variable connected to a moving target?
If mailobj.Sent = False Then
Sleep 100
Else
MsgBox "The email has been sent."
'other code
Exit Do
End If
Loop
Create a class and add MailItem as the event enabled property of that class. Handle the events such as Open/Write/Send/Save etc. to have custom control on the e-mail life-cycle. EntryID is the unique property for each mail item.
Be cautious of the fact that Entry Id is only generated after the first save of the item and changes implicitly when user manually moves the item between folders.
Following a is an example to get you started:
Add a class Class1 like this
Option Explicit
Public WithEvents mItem As MailItem
Public id As String
Private Sub mItem_Open(Cancel As Boolean)
MsgBox "Mail item will be displayed."
id = mItem.EntryID
End Sub
Add a module with following code:
Option Explicit
Sub test()
Dim cls As New Class1
Dim id As String
Dim outlobj As Outlook.Application
Dim mailobj As Outlook.MailItem
Set outlobj = Outlook.Application
Set mailobj = outlobj.CreateItem(olMailItem)
Set cls.mItem = mailobj
With mailobj
.Recipients.Add "xx#yy.zz"
.Subject = "Test"
.Body = "Test Content of the e-mail."
.Save
.Display
id = cls.id '/ Store ID for later use.
Debug.Print id
End With
'/ Search that e-mail and display its body contents
Call Retrieve(id)
End Sub
Sub Retrieve(sEntryId As String)
Dim mailobj As Outlook.MailItem
Dim ns As NameSpace
Set ns = GetNamespace("MAPI")
Set mailobj = ns.GetItemFromID(sEntryId)
MsgBox mailobj.Body
End Sub
Run the sub test
As referenced from this post, Excel VBA for searching in mails of Outlook, I changed the code slightly to resend all emails to the same recipient in the "sent items" folder.
Function ReplyEmail()
Dim olMail
Dim olMails
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderSentMail)
Set olMails = olFldr.Items
For Each olMail In olMails
olMail.ReplyAll
olMail.Importance = 2
olMail.Subject = "RE: 2ND " & olMail.Subject
olMail.Send
Next olMail
End Function
However, for some strange reason, this function sends only half of all emails in designated folder. If there are 9 emails, the function sends out 5 (4 left), then if I run another iteration, the function sends out 2, and so on...
If I change olMail.Send to olMail.Display, then the function displays all emails in pop-up frames.
Has any one encountered this issue or know what's the reason behind it?
Thanks.
For starters, I don't understand why you are not using the MailItem object returned from the ReplyAll method to set the properties and call .Send on that object and not the copy of the sent item represented by your olMail variable.
Otherwise I suspect the collection of items is changing. Change the For Each to a For with a reverse counter loop and the weirdness should go away.
I have a macro that works for forwarding multiple Outlook items as attachments. I've pasted that below, but I want it to also add the forwarded message(s) to a category in outlook. So, not only would it forward the items that are in my inbox to the recipient, but it would also mark those items in a certain category. This way I could track which items I have forwarded using the macro. As it is now, it will show me the item has been forwarded on such and such date, but that may have been just a regular forwarding action. Hence the need for the macro to add the item to a specialized category.
Sub ForwardSelectedItems()
On Error Resume Next
Dim objItem As Outlook.MailItem
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
Set objMsg = objItem.Forward()
With objMsg
.Attachments.Add objItem, olEmbeddeditem
.Subject = "example"
.To = "example#example.com"
.Body = “”
.Send
End With
Next
Set objItem = Nothing
Set objMsg = Nothing
End Sub
The Categories property of the MailItem class allows to set a string representing the categories assigned to the Outlook item. Here is what MSDN states:
Categories is a delimited string of category names that have been assigned to an Outlook item. This property uses the character specified in the value name, sList, under HKEY_CURRENT_USER\Control Panel\International in the Windows registry, as the delimiter for multiple categories. To convert the string of category names to an array of category names, use the Microsoft Visual Basic function Split.
Note, you can use the Categories property of the Namespace class to get a Categories object that represents the set of Category objects available. This property represents the Master Category List, which is the set of Category objects that can be applied to Outlook items contained by the NameSpace object, and applies to all users of that namespace.
Also you may consider specifying the SaveSentMessageFolder for the mail item. The property allows to set a Folder object that represents the folder in which a copy of the e-mail message will be saved after being sent. So, you can easily recognize the auto-forwarded messages.
EDIT: New info: I just now realised that, while the return of Mailitem.Body is "", the actual value is "Application-defined or object-defined error" . I'm not entirely sure what that means, but I do know it shows up in multiple fields-- I included a screen shot below.
I am having an issue where certain properties will return the correct value, and others will not. I have an example email, where I have an email with subject "Subject", the message is "Body", the sender email address is "email#address.com", and the date sent is 12 June 2013.
When I run the following code:
Dim ComputerName As String
Dim ErrorState As String
For Each MailItem In InboxItems
ComputerName = MailItem.Subject
'ErrorState = MailItem.Body
ErrorState = MailBody(MailItem)
strDate = GetDate(MailItem.SentOn)
SenderEmail = MailItem.SenderEmailAddress
If strDate = DateToday And SenderEmail = "email#address.com" Then
Computers(a, 0) = ComputerName
Computers(a, 1) = ErrorState
a = a + 1
End If
Debug.Print MailItem.Subject
Debug.Print MailItem.Body
Next MailItem
What I get is ComputerName = "Subject", ErrorState = "", SenderEmail = "", and strDate = "2013/6/12" (which is the proper format in this case). Why would this return proper values for two of the Mailitem properties, but not for two of the others? This is a very strange problem, and I would appreciate any help you all might be able to give!
I will add more of the context for the code here:
Set objOutlook = CreateObject("Outlook.Application", "localhost")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set Inbox = GetFolder("email#address.org/inbox")
Set InboxItems = Inbox.Items
InboxItems.SetColumns ("SentOn")
GetFolder is a function to get the mailbox by folder path. I have to do this because I am not using the default inbox in outlook.
I also tried using the MailBody Function proposed below, in case the body were in an HTML or RTF format. Unfortunately, it proved that the body was normal, and MailItem.Body should have retrieved it, and it still is not working. MailItem.Body returns "", even though I know that the email has a body. The body is just the number 1, and that is what I should be getting.
Also, I should note that the sender of the email is the same as the recipient; in other words, the email was sent from one email address to itself. I don't know if this could make a difference, but I figured that I would put it out there just in case.
Multiple Item Types
First, there is no guarantee that all items in the Inbox.Items collection are of type MailItem. Inboxes also contain AppointmentItem, MeetingItem, and other *Item type objects. Not all of these item types have the same properties populated. To ensure you do not get a type mismatch error, declare your iterator variable as a generic Object and only assign it to a strongly-typed MailItem variable if it is of the correct type:
Dim oInbox As Outlook.Folder
Dim oItem As Object
Dim oMailItem As MailItem
Set oInbox = ActiveExplorer.Session.DefaultStore.GetRootFolder().Folders("Inbox")
For Each oItem In oInbox.Items
If TypeOf oItem Is MailItem Then
Set oMailItem = oItem
' Do stuff
Else
Debug.Print "Skipping " & TypeName(oItem)
End If
Next
Optional properties
Second, there is no gaurantee that all properties of an object will be populated. If a mail item was never sent, it will have no sender address, and certainly it is possible to have an email with no body. A good way to get familiar with which properties are available and what they contain is to use the Locals window (View > Locals Window in the VBA IDE). Here's a screen shot of the above code paused in the loop, with some of the properties of the oMailItem object expanded:
Body vs. HTMLBody
MailItem objects have three body properties: Body, HTMLBody, and RTFBody. Usually only one of them is populated. Which one depends on the format of the email. You can check the BodyFormat property to find which one is applicable to the current item. Using that, here's a generalized way to get the raw body of a MailItem, no matter what the format:
Public Function MailBody(ByVal MailItem As MailItem) As String
Select Case MailItem.BodyFormat
Case OlBodyFormat.olFormatPlain, OlBodyFormat.olFormatUnspecified
MailBody = MailItem.Body
Case OlBodyFormat.olFormatHTML
MailBody = MailItem.HTMLBody
Case OlBodyFormat.olFormatRichText
MailBody = MailItem.RTFBody
End Select
End Function