I need to validate if an incoming mailitem is signed in Outlook 2010.
If a mailitem is not signed, it should be moved into a "NOSIG"-folder.
While researching, I found (and sort of confirmed) that Outlook 2010 modifies the MessageClass to "IPM.Note", so I tried to use the PropertyAccessor and read the Security-Flags.
Here's my code so far:
Sub TRCR(MAIL_ITEM As MailItem)
Dim PR_SECURITY_FLAGS As Integer
On Error Resume Next
'Security-Flags: 0=none, 1=encrypted, 2=signed, 3=both
PR_SECURITY_FLAGS = MAIL_ITEM.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x6E010003")
'Modulo because, sometimes the flags value is added to a multiple of 32... <unfortunately I lost the source>
If (PR_SECURITY_FLAGS > 32) Then PR_SECURITY_FLAGS = PR_SECURITY_FLAGS Mod 32
If PR_SECURITY_FLAGS = 2 Or PR_SECURITY_FLAGS = 3 Then
'Do all that fancy stuff I want to with that signed Mail
Else
MAIL_ITEM.Move Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders.Item("NOSIG")
End If
End Sub
I use an Outlook rule to run that script on every incoming E-Mail.
It sometimes moves signed mails to the NOSIG folder.
In those cases, the PR_SECURITY_FLAGS were both at 0, before and after that Modulo-Codeline. So being 0, the script worked right but since the mail was signed, the flag shouldn't have been 0 but 2.
I resent the same signed mail dozens of times, just to always see the same thing happening. Most of them are treated correctly while a few always appeared to show the flag 0 instead of 2 while they were signed.
I tried to pause the script for 1-5 seconds with Application.Wait Now + TimeSerial(0, 0, 1) thinking that the script may be too fast for the PropertyAccessor or something, but the pause didn't work. (I couldn't "feel" that five seconds delay while processing multiple mails.)
I start to think that it is an Outlook problem (maybe manipulating Security-Flags similar to MessageClass but not every time).
PR_SECURITY_FLAGS is only set on the outgoing messages to tell Outlook to encrypt the message when it is actually sent. It will not be present on the incoming messages - take a look at the messages with OutlookSpy (I am its author - click IMessage button).
For the incoming messages, you'd think you could check the MessageClass property and see if it is "IPM.Note.SMIME.MultipartSigned", but OOM tries real hard to represent signed and encrypted messages as the regular IPM.Note messages. You would have to either bypass OOM completely and use Extended MAPI (C++ or Delphi only) or you can use Redemption (any language, including VBA, I am its author). Something like the following would let you check the real message class:
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set SourceMsg = Session.GetRDOObjectFromOutlookObject(MAIL_ITEM , true)
MsgBox SourceMsg.MessageClass
Related
I have an Exchange mailbox with a bunch of Outlook ReportItem Undelivered messages. I am attempting to reprocess the undelivered messages via an Outlook VBA script by invoking the "SendAgain" operation on the ReportItem messages. My issue is that the ReportItem does not have a send method, so I have no way of actually sending the reprocessed messages. I am using the following code to go through the messages:
Dim objApp As Outlook.Application
Dim objNameSpace As NameSpace
Dim journalAlertInbox As Folder
Dim objInspector As Inspector
Dim resendItem As ReportItem
Set objApp = CreateObject("Outlook.Application")
Set objNameSpace = objApp.GetNamespace("MAPI")
Set journalAlertInbox = objNameSpace.Stores.Item("thestore").GetDefaultFolder(olFolderInbox)
For Each folderItem In journalAlertInbox.Items
If TypeOf folderItem Is ReportItem Then
folderItem.Display
Set objInspector = folderItem.GetInspector
objInspector.CommandBars.ExecuteMso "SendAgain"
Set resendItem = Application.ActiveInspector.CurrentItem
Set objInspector = resendItem.GetInspector
''how do I send the item that is now displayed?
''resendItem.Close olSave
folderItem.Close olDiscard
End If
Next folderItem
I thought I might be able to save the displayed message as a draft, however If I uncomment the resendItem.close olSave line this results in a message in my Outlook Drafts folder of type ReportItem. I can open up the saved draft message it the Outlook GUI and click the send button, but I do not see a way to actually invoke the send operation programmatically. Examining the message in drafts shows it to be of type ReportItem, which does not have a .Send method.
How can I invoke the "Send" operation on the Report Item? I can clearly see the "Send" button, but there seems to be no programmatic way of actually clicking it.
OOM does not expose any functionality that allows to link a ReportItem object to the original MailItem, and, generally, there might not be any kind of link between the two. The best you can do is to retrieve PR_ORIGINAL_SEARCH_KEY MAPI property (or PR_REPORT_TAG, which includes both the search key and the store/Sent Items folder entry id) using ReportItem.PropertyAccess.GetProperty and try to find a matching message in the Sent Items folder. You can see these properties in OutlookSpy (I am its author).
Keep in mind that OOM does not allow to search on the binary (PT_BINARY) properties in Items.Find/Restrict.
If using Redemption is an option (I am also its author), it exposes RDOReportItem.FindOriginalItem method.
Once you have the original item, you can make a copy and try to send it again.
The ReportItem doesn't represent the original item which is failed to be sent. Also it doesn't contain any relationship with the original mail item, so you will not find any property or method available in the Outlook object model. Your existing solution looks good.
You may also try using the ReportItem.GetConversation method which obtains a Conversation object that represents the conversation to which this item belongs. So, you may try getting the previous item from the conversation, it could be the original item which has been submitted.
I process (loop over) emails in my folders with vba procedure. in case an email is encrypted, i get the error
I want to simply ignore encrypted emails for my processing. I could do the "on error continue", but i'd prefere some
if IsEncrypted(mailitem) then
skip and go to next mailitem
end if
Can anybody help me with this?
Found it. any mailitem has the .MessageClass property, which in case of my encrypted emails is "IPM.Note.SMIME". simply checking for this string exactly answers my question
You may check the PR_SECURITY_FLAGS property value.
Const PR_SECURITY_FLAGS = "http://schemas.microsoft.com/mapi/proptag/0x6E010003"
Const SECFLAG_ENCRYPTED As Long = &H1
Dim SecFlags As Long
' Get current flags value
SecFlags = oItem.PropertyAccessor.GetProperty(PR_SECURITY_FLAGS)
Read more about that in the How to sign or encrypt a message programmatically from OOM article.
Please remember that third-party add-ins may encrypt messages without changing the message class or security flags. They will look like a regular email. In that case, you will have to parse the message body to detect them.
I receive emails with subjects of the form “### auto fax” where “###” is a variable number of digits. Each of these emails must be forwarded to “####mail2fax.com”. I am looking for ideas on how to automate this.
Your addition “and it needs me to be at office” may be a problem. I am a home user of Outlook. If I want Outlook to do any while I am away, I need to leave my computer switched on. I assume you are an Outlook Exchange user. You can leave instructions that will be obeyed while you are away even if your computer is switched. However, for security reasons, the default is that you cannot leave instructions to forward an email outside your company. As I understand it, you would need to forward the “Auto fax” emails to a colleague. Since we hope to automate the process, this should not be an imposition on your colleague. You would need to create a version of your rule and macro and install it on your colleague’s computer but this should not be too difficult if my reading of this functionality is correct. The point is, that this will not be part of this answer.
A difficulty with VBA is that there are usually several ways of achieving the same effect. This does not matter if you develop your own VBA; pick your favourite way of achieving an effect and experiment until you have a full understanding of that favourite. However, if you ask for help or look for useful snippets of code, you must have a basic familiarity with every way of achieving effects because others will not share your favourite. You may find you have to get the idea of what a snippet does and then rewrite it your way. This code is written using my favourite techniques.
When you write a macro to process emails, you have two issues:
How do you select the emails you wish to process?
How do you process the selected emails?
There are four methods of selecting emails:
The user selects one or more emails and then runs the processing macro.
The macro scans one or more folders looking for emails with particular characteristics and then processes them.
You instruct Outlook to monitor a particular folder and to run a macro every time a new email arrives in that folder.
You set up a rule to select emails as the arrive and link a macro to that rule to process them.
I believe method 4 will be the easiest method to implement your requirement. However, it may not be available. It works fine on my system but apparently those responsible for an Outlook Exchange installation can forbidden it. If method 4 does not work for you, I believe method 3 will be the next best method. However, this answer will use method 1.
I use method 1 whenever I am developing a new email processing macro. If gives me total control of which emails are processed in which order. I can start with simple emails and I can run the macro against the same email again and again until I get the macro working just the way I want. Once I am satisfied with the macro, I can switch to whichever of the other methods is most appropriate.
This is the first version of my processing macro:
Public Sub ForwardAndMoveEmail(ByRef ItemCrnt As Object)
Dim FaxNum As String
Dim ItemNew As MailItem
Dim Subject As String
If ItemCrnt.Class <> olMail Then
' Ignore item if it is not an email
Exit Sub
End If
Subject = ItemCrnt.Subject
If LCase(Right$(Subject, 9)) = " auto fax" Then
‘ Only process email if the subject ends with case-insensitive " auto fax"
FaxNum = Mid$(Subject, 1, Len(Subject) - 9)
With ItemCrnt
Subject = "Fax from " & .Sender & " (" & .SenderEmailAddress & ")"
Set ItemNew = .Forward
End With
With ItemNew
.Subject = Subject
' Clear existing recipient(s)
Do While .Recipients.Count > 0
.Recipients.Remove (1)
Loop
.Recipients.Add FaxNum & "#mail2fax.com"
.Save
End With
End If
ItemCrnt.Move ItemCrnt.Parent.Parent.Folders("Faxed")
End Sub
The item to be processed is a parameter to this macro. Note that I have typed it as an Object rather than as a MailItem. Then note that the first statements of the macro checks that the item is a MailItem (Class = olMail). With method 1, the user could select something other than a MailItem. This check ensures this user error causes no problem for the macro.
Next the macro checks the Subject ends in “ auto fax” or “ Auto fax” or “ AUTO FAX” or any other variation. With method 1, the user could select the wrong MailItem. With method 3, every email is passed to the macro. Hence, the check that it is a macro to be forwarded to the fax service.
If I decided in advance which selection method I was going to use, I would not need to perform all these checks. I think that being able to change the selection method is worth the extra checks.
The macro extracts the leading characters of the Subject. I do not check that they are numeric although such a check could be added if it was important.
The macro creates a new Subject for the forwarded email. I do not know if you would want a new Subject but this demonstrates what you can do if it was helpful.
Set ItemNew = .Forward creates the item to be forwarded. Note that this statement is within a With block. This is the same as Set ItemNew = ItemCrnt.Forward.
The macro then works on ItemNew. It changes the Subject, it clears the existing recipients and adds the new one and then saves the new email as a draft.
The last statement of the macro is something else you did not ask for but which may be useful. I have created a folder named “Faxed” and I move the original email to it. This saves the original email without cluttering your Inbox.
Consider ItemCrnt.Parent.Parent.Folders("Faxed"). This is the folder to which the item is to be moved. I have chained properties together in a way that probably looks strange but is straightforward once you understand it.
ItemCrnt is the original mail item.
ItemCrnt.Parent is a property of ItemCrnt. Many objects have parents. For a MailItem it is the folder holding the MailItem; that is, folder “Inbox”.
`ItemCrnt.Parent.Parent is a property of folder “Inbox”. For a folder, its parent is the folder containing it. Since folder “Inbox” is a top-level folder, its parent is the store holding it. A “store” is a file in which Outlook stores folders, mail items, calendar items, tasks and many other things.
Having gone all the way up to the store, ItemCrnt.Parent.Parent.Folders("Faxed") goes down to a folder within the store.
The macro that calls ForwardAndMoveEmail is:
Option Explicit
Sub SelectEmailsUser()
Dim Exp As Explorer
Dim ItemCrnt As Object
Dim MailItemCrnt As Object
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Call MsgBox("Please select one or more emails then try again", vbOKOnly)
Exit Sub
End If
For Each ItemCrnt In Exp.Selection
If ItemCrnt.Class = olMail Then
Call ForwardAndMoveEmail(ItemCrnt)
End If
Next
End Sub
Don’t worry too much about this macro at this stage. Study it later when you are ready to develop your next processing email. It is a macro I wrote a long time ago. Each time I want to test a new email processing macro I simply change statement Call ForwardAndMoveEmail(ItemCrnt) to call the new macro.
This is not the final version of the processing macro although it is probably the final version of this evening. Please:
Copy the two macros to an Outlook module. The two macros can be in either order but Option Explicit must be at the top of the module.
Create folder “Faxed”. At the same level as folder “Inbox”.
Select one or more of the “Auto fax” emails and run macro SelectEmailsUser.
Check the processed “Auto fax” emails are now in folder “Faxed”.
Review the emails in folder Drafts. I think these emails are unsatisfactory. I will tell why later and what I think you should do to make them satisfactory.
Part 2
I ended the first part of this answer by saying I did not think the draft email my macro had created was satisfactory.
The problem for me is that the original email is headed up by a typical “forwarded” header: original sender, my name, date sent and subject. The author of the email has presumably spent some time creating the text of the email and would not want this irrelevant header prefixing their text. So how was I to stop this header being included in the email sent to “mail2fax.com”?
My first idea was to use method “Copy” instead of method “Forward”. This did give a satisfactory appearance but was slight awkward. With the statement Set ItemNew = ItemCrnt.Forward, ItemNew is a draft email ready to be finished and saved in folder “Drafts” or sent. But with the statement Set ItemNew = ItemCrnt.Copy, ItemNew is a received email and, when saved, is placed in folder “Inbox”. I have sent a copied email and the appearance when it arrives at one of my secondary email addresses looks satisfactory.
My second idea needs an introduction. An email can have three bodies: plain text, HTML or RTF. I have never seen an email containing a RTF (Rich Text Format) body. RTF was probably a sensible format 20 years ago if you wanted more that plain text. But today, HTML is so powerful that the same email can be rearranged for a large PC screen, a tablet or a smart phone so it is always easy to read. So for all practical purposes there are only two formats for an email: plain text and HTML. If an email has both plain text and HTML bodies, it is the HTML body that is shown to the reader. The VBA programmer can look at either or both bodies but the reader is not told that there is a plain text body. Very occasionally, I have seen a carefully constructed plain text body that has been designed for an email package that cannot handle HTML. But normally the plain text body is just the HTML body with the HTML tags stripped out.
My second idea was to use method “Forward” but then to copy the text and HTML bodies from the original email.
In the above code, you will find:
.Subject = Subject
' Clear existing recipient(s)
Please replace these two lines with:
.Subject = Subject
.Body = ItemCrnt.Body
.HtmlBody = ItemCrnt.HtmlBody
' Clear existing recipients
With this change, the draft emails will not have a “forwarded” header.
I assume you know who these emails are being faxed to. I suggest you contact one or two and say you are going to conduct an experiment. They will have already received faxes as a result of you using the keyboard interface to forward these emails. Send some of the draft emails created by my macro and ask for the recipients’ opinion on the new appearance. If they prefer the new appearance, we will be ready to move on to stage 3: Automating these emails. If they do not like the new appearance, you will need to ask them what is wrong about the new appearance and we will have to attempt to fix the problem.
Part 3
Please do not follow the instructions in this part until you are convinced that emails created by macro ForwardAndMoveEmail are as they should be. This part is about automating the process so the emails will be sent without you having any opportunity to check or correct them before they are sent.
Please make the following changes to macro ForwardAndMoveEmail:
Replace Public Sub ForwardAndMoveEmail(ByRef ItemCrnt As Object)
by Public Sub ForwardAndMoveEmail(ByRef ItemCrnt As MailItem).
With email selection method 1, it is possible (difficult but possible) to select items that are not MailItemss. I set the type of ItemCrnt to Object so this would not cause an error. To use a macro with a rule, ItemCrnt must be MailItem.
These statements are now redundant:
If ItemCrnt.Class <> olMail Then
' Ignore item if it is not an email
Exit Sub
End If
You can leave these statements since they will do no harm. Alternatively, you could delete them or place a quote in front of each statement.
Replace .Save by .Send.
On my system I can attach a macro to a rule. If you can do the same, it will be the easiest approach. However, some IT departments consider attaching a macro to a rule to be a security risk and disable it. If you find you cannot attach a macro to a rule, you will have to try the event approach. I will add additional instructions if necessary.
The screenshots below are from my home Outlook installation. You have functionality I lack so the screens you see will not be identical. However, my screenshots should be similar enough to yours to be useful.
Select one of these “auto fax” emails. From the “Home” tab click “Rules” then “Create Rule...”. You will get a pop-up window like this:
I created an “Auto fax” email in one of my secondary accounts and sent it to me main account. This is why I am shown as both the sender and the receiver. Because I had selected the “Auto fax” email, its subject is shown. Edit this subject to remove the leading digits. A tick will appear in the box next to the subject to get:
Click “Advanced Options...” to get this pop-up window:
Notice that subject in the line near the top has not been edited. This does not matter; it is the value in the “Step 2” box that matters. Note that if you click “ Auto fax” in the “Step 2” box, you can add extra values. So if some of these emails have slightly different subjects, you can add these alternative values. Click “Next” to get a pop-up window like this:
Near the bottom is “Run a script”. You will have more options and may have to scroll down to see this option. Click the box next to this option. “Run a script” will appear in the “Step 2” box. Click “Run a script” in the “Step 2” box. You will be asked to “Enable macros” if you have not done so already. A new pop-up window will appear showing all the macros that could be selected for this option. I have several possible macros so I will not show you my list. You should only see one macro: ForwardAndMoveEmail. To appear in this list, a macro must be Public and the first parameter must be a MailItem. Select ForwardAndMoveEmail if it isn’t selected and click “OK”. “Run a script” now reads “Run ForwardAndMoveEmail”. Click “Next”. You will get a pop-up window of exceptions which I assume are irrelevant to you. Click “Next” to get the final pop-up:
You can click the box against ‘Run this rule now on messages already in “Inbox”’ to forward any of “Auto fax” emails already received but not forwarded. Click “Finish”.
The “Auto fax” rule is now operational and any “Auto fax” emails will be forwarded automatically. It would be a good idea to monitor folder “Faxed” and check the intended recipients received their faxes.
If certain users automate the Outlook Client to view bounce backs/ReportItems in a shared inbox, rather than returning the clear text of the message as indicated by the documentation there is a unicode string that has been parsed as a UTF-8 string - so it looks like Chinese.
I can get past that with some code, but the additional issue is that this change occurs in Outlook as well for all users with access to that inbox. The message itself as viewed in Outlook appears as Chinese characters - the original unicode html parsed as UTF-8.
We are using the normal methods to access the report item:
For Counter as Integer = Inbox.Items.Count To 1 Step -1
Dim Report As Outlook.ReportItem = Inbox.Items(Counter)
Dim Body As String = Report.Body
The last line is where we get the garbled text In VBA it attempts to parse it as ASCII and returns a large block of "?". In .Net it returns the value parsed as UTF-8 and we get the characters that appear Chinese. In either case the report item in the inbox begins displaying as Chinese characters and continues to do so for all users of that inbox.
I just had this happen to my VBA function in Outlook that processes email bounce backs for orders and marks those orders as requiring attention. The original email in outlook looks fine but when I attempt to process it, the characters change to Chinese and Report.Body just shows question marks.
I found using StrConv to convert to Unicode could get me the correct body contents for processing.
Dim strBody as String
strBody = StrConv(Report.Body, vbUnicode)
Are you sure that the Inbox.Items(Counter) call returns an instance of the ReportItem class? Did you have a chance to check out the MessageClass property?
Most probably you try to cast an instance of the MailItem class to the ReportItem class. Is that the case?
Also I'd suggest using any low-level property viewer such as MFCMAPI or OutlookSpy for observing properties at runtime. Do you see "chinese" charactere there?
I came across this issue and I've written a function that solves the issue for me. I thought I'd share it here in case it's of use to anyone else.
Private Sub Example()
Dim Item As Object
Set Item = Application.ActiveExplorer.Selection(1)
Debug.Print ItemBody(Item)
End Sub
Public Function ItemBody(Item As Variant) As String
On Error Resume Next
If TypeName(Item) = "ReportItem" Then
With Item.GetInspector
ItemBody = .WordEditor.Content
.Close 1
End With
Else
ItemBody = Item.Body
End If
End Function
Yes, there is a problem with ReportItem.Body property in the Outlook Object Model (present in Outlook 2013 and 2016) - you can see it in OutlookSpy (I am its author): select an NDR message, click Item button, select the Body property - it will be garbled. Worse than that, once the report item is touched with OOM, Outlook will display the same junk in the preview pane.
The report text is stored in various MAPI recipient properties (click IMessage button in OutlookSpy and go to the GetRecipientTable tab). The problem is the ReportItem object does not expose the Recipients collection. The workaround is to either use Extended MAPI (C++ or Delphi) or Redemption (any language - I am also its author) - its ReportItem.ReportText property does not have this problem:
set oItem = Application.ActiveExplorer.Selection(1)
set oSession = CreateObject("Redemption.RDOSession")
oSession.MAPIOBJECT = Application.Session.MAPIOBJECT
set rItem = oSession.GetRDOObjectFromOutlookObject(oItem)
MsgBox rItem.ReportText
I get two messages everday. The second message must arrive within 3.5 hours; if not, I have to start figuring out what went wrong with the second process that kept that email from getting sent.
Here's what I'd like to see happen.
Message one arrives
A rule executes and flags the message for follow-up (or anything really) 3.5 hours from that time.
There's a "run script" option in Outlook's Rules Wizard that I would use to trigger the script.
Bonus Points:
3 . When the second email arrives, it clears the follow-up flag from the first message.
Here's what I did:
Sub MyRule(Item As Outlook.MailItem)
MsgBox "Mail one has arrived: " & Item.Subject
Dim newMail As Outlook.MailItem
Set newMail = Outlook.CreateItem(olMailItem)
newMail.To = Item.To
newMail.Subject = "!!!Start looking for issues!!!!"
newMail.Body = "Something might have gone wrong with the process.. You did not receive any closing mail for " + Item.Subject + " received on " + Item.ReceivedTime
newMail.DeferredDeliveryTime = DateAdd("h", 3.5, Now)
newMail.Send
End Sub
This mail sits in your outbox for 3.5 hours and then gets sent.
This works only if you keep outlook running about 3.5 hours after the first mail. Till then when you try to close outlook, it will say that there are items in the outbox which are not sent. You can safely ignore this warning, but make sure that you have Outlook running afterwards.
(some of the code was written and tested in Outlook. but the body and subject part i have typed outside the VB Editor. You might have to resolve minor errors.)
EDIT:: for Bonus points..
Sub MyRuleForMessageTwo(Item As Outlook.MailItem)
Dim myitem As Outlook.MailItem
Set OutboxItems = Application.Session.GetDefaultFolder(olFolderOutbox).Items
Set myitem = OutboxItems.GetFirst
Do While Not (myitem Is Nothing)
If myitem.Subject = "!!!Start looking for issues!!!!" Then
myitem.Delete
Exit Do
End If
Set myitem = OutboxItems.GetNext
Loop
End Sub
You can play around with the matching criteria if you expect more than one message to be sitting in your outbox and you want to delete only one.
First of all, it sounds like you are creating a bizarre Rube Goldberg contraption, but that's going to be your problem, not mine, so have fun!
The way I would do this is to write a simple script that iterates through all messages in the inbox. Set the script to run every five minutes or so.
When it finds the first message of a pair, it records the time that message arrived. If it finds the second message, it checks to make sure that it arrived within 3.5 hours. If it doesn't find the second message, it checks if 3.5 hours have elapsed and warns you if they have.
There is no need to set flags on the first message. This doesn't get you any additional information that your script can't figure out later.