Attachment-less Mailbox Script - Part 2 how it works

OnSave Event sink                                                             Download Script

The following script is designed to run as an onsave event sink script and be registered at the top level of a mailbox. What this script does is opens up the email that fired it and then downloads any attachments on this message to a specified file share then deletes the attachments and appends a link to the body of the email with the location of where the file was downloaded to.

Cavet: Even though the method I'll describe about registering this event sink will mean it will fire on all folders in a mailbox you cannot fire an event sink on the outbox or sent items folder see this Qbase article for more details. So if you want to archive attachments to a file server that are stored in the sent items or outbox folder you need to run a separate sent items archive script see my other article for ideas on this

The first part of this script setups up some constants that are used to determine if the event that fired is because a new mail has been delivered or a new item has been created in the users inbox. It does this by using the Iflags parameter that is passed into the sub.

<SCRIPT LANGUAGE="VBScript">

Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)
on error resume next    
Const EVT_NEW_ITEM = 1
Const EVT_IS_DELIVERED = 8


If (lFlags And EVT_IS_DELIVERED) Or (lFlags And EVT_NEW_ITEM) Then

If these conditions are met the mail that triggered the event is opened up and any attachments that are on that message are saved to a file share with the attachment name as the start of the file name and the received time as the end of the filename. This is done to ensure that the filenames are unique. In this part of the code you need to customize the savepath variable to what you want it to be eg (usershomedrive\attachments). An array is used to record each of the attachment paths that will be used later in the code.

Set msgobj = CreateObject("CDO.Message")
msgobj.DataSource.Open bstrURLItem, ,3 
if msgobj.fields("urn:schemas:httpmail:hasattachment").value = True and msgobj.fields("DAV:contentclass").value = "urn:content-classes:message" then
	Set fso = CreateObject("Scripting.FileSystemObject")
	set wfile =  fso.opentextfile("c:\temp\fnwork1.txt",2,true)
	savepath = "c:\temp\newb2\"
	attachcount = msgobj.attachments.count
	redim attarray(attachcount)
	redim attnarray(attachcount)
	arrcnt = 1
	For Each objAttachment In msgobj.Attachments
		attext = mid(objAttachment.filename ,(instr((len(objAttachment.filename)-3),objAttachment.filename,".")+1) ,len(objAttachment.filename))
		attname = mid(objAttachment.filename , 1,instr((len(objAttachment.filename)-3),objAttachment.filename,".")-1)
		rtime = replace(msgobj.ReceivedTime,"/","-")
		rtime = replace(rtime,":","-")
		savefile = savepath
		savefile = savefile & attname & "_" & rtime & "." & attext
		objAttachment.SaveToFile savefile
		attarray(arrcnt) = savefile
		attnarray(arrcnt) = objAttachment.filename
		arrcnt = arrcnt + 1
	next

The next part of the code deletes all the attachments on a messages by calling the deleteall method of the message object (note its not possible as far as I know to delete a single attachment on an email) After the attachment has been deleted it creates a hyperlink at the end of the message the points to the location where the attachment was downloaded to, for multiple attachment emails is loops back through the array of attachment paths to create multiple hyperlinks for these attachments. For this part a HTML body and Text body is provided. Note if the email is in Rich Text this email will be converted to HTML. (Its possible that some RTF formatting will be lost in this conversion)

	msgobj.attachments.deleteall
	if msgobj.HTMLBody <> "" Then
	if Instr(1,msgobj.HTMLBody,"</BODY") > 0 Then
		sHTMLBody = Left(msgobj.HTMLBody,Instr(1,msgobj.HTMLBody,"</BODY>")-1)
	Else
		sHTMLBody = msgobj.HTMLBody
	End if
	end if
	For I = 1 to attachcount
		msgobj.textbody = msgobj.textbody & vbCRLF & "****** Attachment: " & attnarray(i) & " <file://" & attarray(i) & ">"
		sHTMLBody = sHTMLBody & vbCRLF & "<BR><B><DIV><FONT face=Arial color=#004000 size=2>****** Attachment: <A href=" & chr(34) & " file://" & attarray(i) & chr(34) & "> " & attnarray(i) & "</A></DIV>"
	next
	msgobj.HTMLBody = sHTMLBody & "<BR><BR></BODY></HTML>"
	msgobj.textbody = msgobj.textbody & vbCRLF & vbCRLF

The next part of the code updates the email and adds a keyword of attachment to the email that was modified above. This is done because its needed to identify that this email has an attachment on the file server that needs to be deleted when the onsyncdelete event sync is fired.

	msgobj.fields("urn:schemas:mailheader:keywords").value = "Attachment"
	msgobj.fields.update
	msgobj.DataSource.Save
	end if
	set msgobj = nothing

end if 

End Sub

</SCRIPT>

Registering the _OnSave event sink.

Because you need to make this a Deep scope sink (eg apply it too all the folders in a mailbox) I recommend you use the Exchange Explorer which comes with the ESDK development tools. Create a deep level onsave event sink on the top level folder in the target mailbox and have a condition for firing this code such as Where "urn:schemas:httpmail:hasattachment" = True. This will mean the sink will only fire on emails that have attachments. (I have tried using the regevent script to do the same thing but found I could never get the syntax right if anybody has a solution for this please email me). A basic registration without the where clause is
cscript regevent.vbs add "onsave" Exoledb.ScriptEventSink.1 file://./backofficestorage/yourdomain/mbx/alias/onsavesink -m deep -file script.vbs

OnSyncDelete Event Sink

The following event sync script is designed to delete a file that has been downloaded as part of the onsave event sink when the message that the attachment was downloaded from is deleted from the email system. It uses the onsyncdelete sink vs. the ondelete method because if you use the ondelete method the mail item has already been deleted before the sink runs, the onsyncdelete method doesn't delete the mail object until after the sink has run.

To start with the script checks to make sure that when the event fired it was a hard delete (eg the users done a shift delete or they have emptyed the item from their recycle bin). The script then looks at the keywords to check if there is an attachment and then parses the body of the message to find the hyperlink to the file attachment. It then uses this information to delete the attachment. This script uses the peventinfo interface to access the contents of the message because at the time of deleting this message it is going to be locked in the store and you wont be able to access it via CDO or any other normal processes

<SCRIPT LANGUAGE="VBScript">

Sub ExStoreEvents_OnSyncDelete(pEventInfo, bstrURLItem, lFlags)
on error resume next    
Const EVT_HARDDELETE = 32

If (lFlags And EVT_HARDDELETE)  Then
	Set DispEvtInfo = pEventInfo
	Set ADODBRec = DispEvtInfo.EventRecord
	slen = 1
	if ADODBRec.Fields("urn:schemas:mailheader:keywords").value = "Attachment" then
		Do until stratend = 1
		if instr(slen,ADODBRec.Fields("urn:schemas:httpmail:textdescription").Value,"****** Attachment: ") then
			slen = instr(slen,ADODBRec.Fields("urn:schemas:httpmail:textdescription").Value,"****** Attachment: ") 
			slen = instr(slen,ADODBRec.Fields("urn:schemas:httpmail:textdescription").Value,"<file://") + 8 
			elen = instr(slen,ADODBRec.Fields("urn:schemas:httpmail:textdescription").Value,">") 
			elen1 = elen - slen
			comex = mid(ADODBRec.Fields("urn:schemas:httpmail:textdescription").Value,slen,elen1)
			slen = elen
			if (fso.FileExists(comex)) Then
				fso.deletefile(comex)
			End If
		else
			stratend = 1
		end if
		loop
	
	end if

end if
End Sub

</SCRIPT>

Registering the _OnSyncDelete event sink

Because you need to make this a Deep scope sink (eg apply it too all the folders in a mailbox) I recommend you use the Exchange Explorer which comes with the ESDK development tools. Create a deep level OnSyncDelete event sink on the top level folder in the target mailbox a basic regevent registration would look like
cscript regevent.vbs add onsyncdelete Exoledb.ScriptEventSink.1 file://./backofficestorage/yourdomain/mbx/alias/onsavesink -m deep -file script.vbs

 Download Script