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

Testing and Sending email via SMTP using Opportunistic TLS and oAuth in Office365 with PowerShell

As well as EWS and Remote PowerShell (RPS) other mail protocols POP3, IMAP and SMTP have had OAuth authentication enabled in Exchange Online (Official announcement here ). A while ago I created  this script that used Opportunistic TLS to perform a Telnet style test against a SMTP server using SMTP AUTH. Now that oAuth authentication has been enabled in office365 I've updated this script to be able to use oAuth instead of SMTP Auth to test against Office365. I've also included a function to actually send a Message. Token Acquisition  To Send a Mail using oAuth you first need to get an Access token from Azure AD there are plenty of ways of doing this in PowerShell. You could use a library like MSAL or ADAL (just google your favoured method) or use a library less approach which I've included with this script . Whatever way you do this you need to make sure that your application registration  https://docs.microsoft.com/en-us/azure/active-directory/develop/quickstart-register-
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 Graph is limited to a m
Read more

How to test SMTP using Opportunistic TLS with Powershell and grab the public certificate a SMTP server is using

Most email services these day employ Opportunistic TLS when trying to send Messages which means that wherever possible the Messages will be encrypted rather then the plain text legacy of SMTP.  This method was defined in RFC 3207 "SMTP Service Extension for Secure SMTP over Transport Layer Security" and  there's a quite a good explanation of Opportunistic TLS on Wikipedia  https://en.wikipedia.org/wiki/Opportunistic_TLS .  This is used for both Server to Server (eg MTA to MTA) and Client to server (Eg a Message client like Outlook which acts as a MSA) the later being generally Authenticated. Basically it allows you to have a normal plain text SMTP conversation that is then upgraded to TLS using the STARTTLS verb. Not all servers will support this verb so if its not supported then a message is just sent as Plain text. TLS relies on PKI certificates and the administrative issue s that come around certificate management like expired certificates which is why I wrote th
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.