Skip to main content

Assigning categories based on the Attachments in a Message via a CDO 1.2 script

This is part 2 of a 2 part post of a few scripts to assign different colored categories to messages based on the type of attachments a message has. See the first post for information on how modify the Outlook 2007 categories’

This script handles enumerating the existing messages within a mailbox and then assigning categories (or keywords) based on the attachment types on the message. When I used this script I did every message in my mailbox which worked okay but because I was using Outlook in Cache Mode updating a lot a messages this way caused a major re-syncing or the cache (e.g. it seemed to pull down every message again that was updated with an attachment which can consume a lot of bandwidth if you have a large mailbox with large attachments). While this may be okay for some people this could cause some havoc in some networks so with this script I put a filter value so it will only update the messages that are less then 1 month old in the inbox. This could still be a considerable number of messages so you should use this script with great care and always test it first in your dev environment.

The script works by first creating a filter on the Messages in the inbox so only messages that have an attachment and are under 1 month old are included in the collection. It then loops through each message and first build a list of any existing keywords on a message. It then checks the attachment and if there is an attachment types that doesn’t have an existing keyword set on the message a new keyword is added to that message. To avoid assigning a keyword to a message with inline attachments such as people who use images in signatures etc the script checks to see if the attachment in question is a inline attachment if that’s the case it skips over this attachment. The keywords assigned to the message match the categories that where created with the first script. The categories themselves are held in a multivalued String property http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Keywords.

This script only updates existing message if you want to set the categories on new messages you would need to look at writing an Event Sink or if your using Exchange 2007 you could use a Transport Agent or EWS Notifications application.

As I said before there is filter to stop it updating more than 1 month worth of mail in the line

attFilter.TimeFirst = DateAdd("m",-1,Now())

To run the code you need to supply the servername and mailbox name of the mailbox you want to run it against as commandline parameters eg

Cscript setkeywords.vbs.vbs servername mailboxname

I’ve put a download of the script here the script itself looks like

snServername = wscript.arguments(0)
mbMailboxName = wscript.arguments(1)

Set objSession = CreateObject("MAPI.Session")
Set catDict = CreateObject("Scripting.Dictionary")
objSession.Logon "","",false,true,true,true,snServername & vbLF & mbMailboxName
set ifInboxFolderCol = objSession.inbox.messages
set attFilter = ifInboxFolderCol.Filter
Set attFilterFiled = attFilter.Fields.Add(&h0E1B000B,true)
attFilter.TimeFirst = DateAdd("m",-1,Now())
For Each moMessageobject In ifInboxFolderCol
ceCatExists = False
catDict.RemoveAll
On Error Resume Next
ccCurrentCats = moMessageobject.Fields.item("{2903020000000000C000000000000046}Keywords").value
If Err.number = 0 Then
ceCatExists = True
For Each existingcat In ccCurrentCats
catDict.add existingcat,1
next
End If
On Error goto 0
oldcatlength = catDict.Count
Call GetCategories(moMessageobject,catDict)
If catDict.Count > oldcatlength Then
wscript.echo moMessageobject.Subject
ReDim newcats(catDict.Count-1)
catkeys = catDict.Keys
For i = 0 to catDict.Count-1
newcats(i) = catkeys(i)
Next
If ceCatExists = True then
moMessageobject.Fields.item("{2903020000000000C000000000000046}Keywords").value = newcats
Else
moMessageobject.Fields.add "Keywords", vbArray , newcats, "2903020000000000C000000000000046"
End If
moMessageobject.update
End if
next
sub GetCategories(msgObject,catDict)
For Each attachment In msgObject.Attachments
On Error Resume Next
inline = 0
fnFileName = attachment.fields(&h3704001E)
Err.clear
contentid = attachment.fields(&h3712001F)
If Err.number = 0 Then
inline = 1
Else
inline = 0
End if
Err.clear
attflags = attachment.fields(&h37140003)
If Err.number = 0 Then
If attflags = 4 Then inline = 1
End if
If Len(fnFileName) > 4 And inline = 0 Then
Select Case Right(LCase(fnFileName),4)
Case ".doc" If Not catDict.exists("Word Attachment") Then
catDict.add "Word Attachment",1
End if
Case ".ppt" If Not catDict.exists("PowerPoint Attachment") Then
catDict.add "PowerPoint Attachment",1
End if
Case ".xls" If Not catDict.exists("Excel Attachment") Then
catDict.add "Excel Attachment",1
End if
Case ".jpg" If Not catDict.exists("Image Attachment") Then
catDict.add "Image Attachment",1
End if
Case ".bmp" If Not catDict.exists("Image Attachment") Then
catDict.add "Image Attachment",1
End if
Case ".mov" If Not catDict.exists("Video Attachment") Then
catDict.add "Video Attachment",1
End if
Case ".mpg" If Not catDict.exists("Video Attachment") Then
catDict.add "Video Attachment",1
End if
Case ".wmv" If Not catDict.exists("Video Attachment") Then
catDict.add "Video Attachment",1
End if
Case ".pdf" If Not catDict.exists("PDF Attachment") Then
catDict.add "PDF Attachment",1
End if
Case ".mp3" If Not catDict.exists("Sound Attachment") Then
catDict.add "Sound Attachment",1
End if
Case ".pps" If Not catDict.exists("PowerPoint Attachment") Then
catDict.add "PowerPoint Attachment",1
End if
Case ".zip" If Not catDict.exists("Zip Attachment") Then
catDict.add "Zip Attachment",1
End if
End select

End if
On Error goto 0

next

End sub


Labels:

Popular posts from this blog

Exporting and Uploading Mailbox Items using Exchange Web Services using the new ExportItems and UploadItems operations in Exchange 2010 SP1

Two new EWS Operations ExportItems and UploadItems where introduced in Exchange 2010 SP1 that allowed you to do a number of useful things that where previously not possible using Exchange Web Services. Any object that Exchange stores is basically a collection of properties for example a message object is a collection of Message properties, Recipient properties and Attachment properties with a few meta properties that describe the underlying storage thrown in. Normally when using EWS you can access these properties in a number of a ways eg one example is using the strongly type objects such as emailmessage that presents the underlying properties in an intuitive way that's easy to use. Another way is using Extended Properties to access the underlying properties directly. However previously in EWS there was no method to access every property of a message hence there is no way to export or import an item and maintain full fidelity of every property on that item (you could export the...
Read more

The MailboxConcurrency limit and using Batching in the Microsoft Graph API

If your getting an error such as Application is over its MailboxConcurrency limit while using the Microsoft Graph API this post may help you understand why. Background   The Mailbox  concurrency limit when your using the Graph API is 4 as per https://docs.microsoft.com/en-us/graph/throttling#outlook-service-limits . This is evaluated for each app ID and mailbox combination so this means you can have different apps running under the same credentials and the poor behavior of one won't cause the other to be throttled. If you compared that to EWS you could have up to 27 concurrent connections but they are shared across all apps on a first come first served basis. Batching Batching in the Graph API is a way of combining multiple requests into a single HTTP request. Batching in the Exchange Mail API's EWS and MAPI has been around for a long time and its common, for email Apps to process large numbers of smaller items for a variety of reasons.  Batching in the Gr...
Read more

Sending a Message in Exchange Online via REST from an Arduino MKR1000

This is part 2 of my MKR1000 article, in this previous post  I looked at sending a Message via EWS using Basic Authentication.  In this Post I'll look at using the new Outlook REST API  which requires using OAuth authentication to get an Access Token. The prerequisites for this sketch are the same as in the other post with the addition of the ArduinoJson library  https://github.com/bblanchon/ArduinoJson  which is used to parse the Authentication Results to extract the Access Token. Also the SSL certificates for the login.windows.net  and outlook.office365.com need to be uploaded to the devices using the wifi101 Firmware updater. To use Token Authentication you need to register an Application in Azure https://msdn.microsoft.com/en-us/office/office365/howto/add-common-consent-manually  with the Mail.Send permission. The application should be a Native Client app that use the Out of Band Callback urn:ietf:wg:oauth:2.0:oob. You ...
Read more
All sample scripts and source code is provided by for illustrative purposes only. All examples are untested in different environments and therefore, I cannot guarantee or imply reliability, serviceability, or function of these programs.

All code contained herein is provided to you "AS IS" without any warranties of any kind. The implied warranties of non-infringement, merchantability and fitness for a particular purpose are expressly disclaimed.