Tuesday, June 29, 2004

Reporting on Inbox Rules with OWA via Script

I've been looking at inbox rules lately and how you can manipulate them via script. Not a really easy thing currently, there is a rule.dll you can use with CDO to create rules but management and reporting are hard tasks. Firstly I wanted to just know how many people on my server where actually using inbox rules. I looked at doing a query of all the rule messages in the inbox but I found this wasn't too accurate a way of reporting on Inbox rules because you tended to pick up all the junk email rules and any other rules whether it was active or not and I really only wanted to know about user created server side inbox rules. I had a look at how OWA was doing it and this seemed to be something I could make use of, all it did was make one get /inbox/?cmd=rules and then this returned a list of all the active inbox rules. So all I needed to put together was a ADSI query of all the users on the Exchange box and put something that would parse the result returned from the OWA get and this is the result. To do this im reusing some OWA commands and the (Microsoft.XMLHTTP) Object i described this method is this blog entry

set rootDSE = GetObject("LDAP://rootDSE")
defaultNamingContext = rootDSE.Get("defaultNamingContext")
Set objSysInfo = CreateObject("ADSystemInfo")

GALQueryFilter = "(&(&(& (mailnickname=*) (| (&objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*)))
))))"
strQuery = "<LDAP://" & objSysinfo.domaindnsname & "/" & defaultNamingContext & ">;" & GALQueryFilter & ";samaccountname;subtree"

Set oConn = CreateObject("ADODB.Connection") 'Create an ADO Connection
oConn.Provider = "ADsDSOOBJECT" ' ADSI OLE-DB provider
oConn.Open "ADs Provider"

Set oComm = CreateObject("ADODB.Command") ' Create an ADO Command
oComm.ActiveConnection = oConn
oComm.Properties("Page Size") = 1000
oComm.CommandText = strQuery
oComm.Properties("Sort on") = "givenname"

Set rs = oComm.Execute
while not rs.eof
cmdexe = rs.fields("Samaccountname")
getrules(cmdexe)
rs.movenext
wend

function getrules(mname)
on error resume next
Set oXmlHttp = CreateObject("Microsoft.XMLHTTP")
oXmlHttp.Open "get", "http://mgnms01/exchange/" & mname & "/inbox/?cmd=rules",False, "", ""
oXmlHttp.setRequestHeader "Accept-Language:", "en-us"
oXmlHttp.setRequestHeader "Content-type:", "application/x-www-UTF8-encoded"
oXmlHttp.setRequestHeader "Content-Length:", Len(szXml)
oXmlHttp.Send szXml
slen = instr(oXmlHttp.responseText,"<TABLE id=""tblRules""")
elen = instr(slen,oXmlHttp.responseText,"</TABLE>")
pstring = mid(oXmlHttp.responseText,slen,elen-slen)
slen1 = 1
rules = "no"
rcount = 0
do until stopit = 1
if instr(slen1,pstring,"nowrap") then
slen1 = instr(slen1,pstring,"nowrap")+13
elen1 = instr(slen1,pstring,"</TD>")
rnames = rnames & "," & mid(pstring,slen1,elen1-slen1)
slen1 = elen1
rules = "yes"
rcount = rcount + 1
else
stopit = 1
end if
loop
wscript.echo mname & "," & rules & "," & rcount & rnames

end function

Friday, June 25, 2004

Recover Deleted Items from the Dumpster Programmatically

I started looking at this because I thought it would be a good way of finding any spam that was getting past my IMF filter that users weren't reporting. So I went of and hit the ESDK and CDO doco for any clues also did a Google crawl and didn't really turn up much except that CDO was not going to do the trick. The next step was to look at OWA and see if I could reuse any of the stuff it uses. After examining some of the conversations my browser was having with OWA I found that OWA was issuing a query with a scope of softdeleted eg "from scope ('SOFTDELETED traversal of ""') . I Googled this which turned up this Blog post from KC which started to fill in a few of the blanks.

The next thing I tried to do was use a Softdeleted traversal in a Exoledb script which although it seemed to be a valid query it didn't work or more to the point the query worked but instead of returning a record set of soft deleted items I just got all normal folder items. I tried the same thing again instead this time using MSDAIPP.dso (which uses WebDAV) and this worked so it seemed that the Softdeleted traversal only works in WebDAV and not Exoledb.

By this time I was quite interested and started thinking that I could go a bit further then just reporting on missed SPAM so I started looking at ways I could maybe copy this data out into a central repository. I started hitting a few problems because although I could access these soft deleted emails as a recordset, I couldn't open a record against any one item because as far as the mail API's where concerned the resource at that URL had been deleted. This lead me back to the OWA conversations I was looking at and I noticed when OWA restored an item from the dumpster it used the /-softdeleted-/-FlatUrlSpace-/ namespace to copy the item back into the store. I tried to access the /-softdeleted-/-FlatUrlSpace-/ directly with a ADO record but this still didn't work so I resigned to just duplicating OWA functionality which was to do a WebDav Bcopy of the items in the dumpster and then BDelete the items from the dumpster using the /-softdeleted-/-FlatUrlSpace-/ to reference the source items. The last problem was to work out what the /-softdeleted-/-FlatUrlSpace-/ property of the email was as this didn't seem to be located in the recordset either, what I found was that the /-softdeleted-/-FlatUrlSpace-/ property was the same as the /-FlatUrlSpace-/ which is available as the http://schemas.microsoft.com/exchange/permanenturl property all I needed was to append (foldername in my case deleteded items)/-softdeleted-/ before /-FlatUrlSpace-/

So what I ended up with is a script that will copy all the items from the Dumpster using a Bcopy into a folder in the users inbox and then deletes all the items from the dumpster. Its important to do the deletion because if you don't you'll end up with duplicates when the user deletes the emails again.


sDestinationURL = "http://yourserver/exchange/yourmailbox/test/"
Set XMLreq = CreateObject("Microsoft.xmlhttp")
XMLreq.open "BCOPY", "http://yourserver/exchange/yourmailbox/inbox/", False
XMLreq.setRequestHeader "Destination", sDestinationURL
xmlstr = "<?xml version=""1.0"" ?>"
xmlstr = xmlstr & "<D:copy xmlns:D=""DAV:"">"
Set Rec = CreateObject("ADODB.Record")
Set Rs = CreateObject("ADODB.Recordset")
rec.open "http://yourserver/exchange/yourmailbox", ,3
inbstr = "http://yourserver/exchange/yourmailbox/deleted items/"
strView = "select * from scope ('SOFTDELETED traversal of """ & inbstr & """') "
Rs.Open strView, rec.activeconnection, 3
If Rs.RecordCount <> 0 Then
while not rs.eof
xmlstr = xmlstr & "<D:target>"
xmlstr = xmlstr & "<D:href>" & replace(rs.fields("http://schemas.microsoft.com/exchange/permanenturl")" _
& ","/-FlatUrlSpace-/","/Deleted Items/-softdeleted-/-FlatUrlSpace-/") & "</D:href>"
xmlstr1 = xmlstr1 & "<D:href>" & replace(rs.fields("http://schemas.microsoft.com/exchange/permanenturl")" _
& ","/-FlatUrlSpace-/","/Deleted Items/-softdeleted-/-FlatUrlSpace-/") & "</D:href>"
xmlstr = xmlstr & "<D:dest>" & replace(rs.fields("Dav:href"),"Deleted%20Items","targetfolder") & "</D:dest>"
xmlstr = xmlstr & "</D:target>"
rs.movenext
wend
End If
xmlstr = xmlstr & "</D:copy>"
XMLreq.setRequestHeader "Content-Type", "text/xml;"
XMLreq.setRequestHeader "Translate", "f"
XMLreq.setRequestHeader "Content-Length:", Len(xmlstr)
XMLreq.send(xmlstr)
If (XMLreq.Status >= 200 And XMLreq.Status < 300) Then
Wscript.echo "Success! " & "Results = " & XMLreq.Status & ": " & XMLreq.statusText
ElseIf XMLreq.Status = 401 then
Wscript.echo "You don't have permission to do the job! Please check your permissions on this item."
Else
Wscript.echo "Request Failed. Results = " & XMLreq.Status & ": " & XMLreq.statusText
End If
XMLreq.open "BDELETE", "http://yourserver/exchange/yourmailbox/Deleted Items/", False
xmlstr = "<?xml version=""1.0"" ?>"
xmlstr = xmlstr & "<D:delete xmlns:D=""DAV:"">"
xmlstr = xmlstr & "<D:target>"
xmlstr = xmlstr & xmlstr1
xmlstr = xmlstr & "</D:target>"
xmlstr = xmlstr & "</D:delete>"
XMLreq.setRequestHeader "Content-Type", "text/xml;"
XMLreq.setRequestHeader "Translate", "f"
XMLreq.setRequestHeader "Content-Length:", Len(xmlstr)
XMLreq.send(xmlstr)
If (XMLreq.Status >= 200 And XMLreq.Status < 300) Then
Wscript.echo "Success! " & "Results = " & XMLreq.Status & ": " & XMLreq.statusText
ElseIf XMLreq.Status = 401 then
Wscript.echo "You don't have permission to do the job! Please check your permissions on this item."
Else
Wscript.echo "Request Failed. Results = " & XMLreq.Status & ": " & XMLreq.statusText
End If

Thursday, June 24, 2004

Using Bcopy with WebDav in a script

There are a bunch of Batch commands in WebDav that allow you to perform multiple actions with one request this is explained here. I was looking at this today for another script I was writing and although the response and requests are documented in the Exchange SDK unfortunately no code examples exist. A wider search of the web didn't really show anything up either. Although its not extremely hard to use it did take me a little while to work out the correct way to use it so I thought I'd post it as I found it helpful. The script copies multiple items in one mailbox folder to another folder in the same mailbox with one XML request.


sDestinationURL = "http://yourserver/exchange/yourmailbox/targetfolder/"
Set XMLreq = CreateObject("Microsoft.xmlhttp")
XMLreq.open "BCOPY", "http://yourserver/exchange/yourmailbox/inbox/", False
XMLreq.setRequestHeader "Destination", sDestinationURL
xmlstr = "<?xml version=""1.0"" ?>"
xmlstr = xmlstr & "<D:copy xmlns:D=""DAV:"">"
xmlstr = xmlstr & "<D:target>"
xmlstr = xmlstr & "<D:href>http://yourserver/exchange/yourmailbox/inbox/test-3.EML</D:href>"
xmlstr = xmlstr & "<D:dest>http://yourserver/exchange/yourmailbox/targetfolder/test-3.EML</D:dest>"
xmlstr = xmlstr & "</D:target>"
xmlstr = xmlstr & "<D:target>"
xmlstr = xmlstr & "<D:href>http://yourserver/exchange/yourmailbox/inbox/test-4.EML</D:href>"
xmlstr = xmlstr & "<D:dest>http://yourserver/exchange/yourmailbox/targetfolder/test-4.EML</D:dest>"
xmlstr = xmlstr & "</D:target>"
xmlstr = xmlstr & "<D:target>"
xmlstr = xmlstr & "<D:href>http://yourserver/exchange/yourmailbox/inbox/test-5.EML</D:href>"
xmlstr = xmlstr & "<D:dest>http://yourserver/exchange/yourmailbox/targetfolder/test-5.EML</D:dest>"
xmlstr = xmlstr & "</D:target>"
xmlstr = xmlstr & "</D:copy>"
XMLreq.setRequestHeader "Content-Type", "text/xml;"
XMLreq.setRequestHeader "Translate", "f"
XMLreq.setRequestHeader "Content-Length:", Len(xmlstr)
XMLreq.send(xmlstr)

If (XMLreq.Status >= 200 And XMLreq.Status < 300) Then
Wscript.echo "Success! " & "Results = " & XMLreq.Status & ": " & XMLreq.statusText
ElseIf XMLreq.Status = 401 then
Wscript.echo "You don't have permission to do the job!."
Else
Wscript.echo "Request Failed. Results = " & XMLreq.Status & ": " & XMLreq.statusText
End If

Wednesday, June 23, 2004

Feeding the simple Html Calendar with Exoledb

Man this was a lot harder then I expected it would be, When it comes to representing time in anything you are really starting to deal with a different dimension (I think time is the third dimension). Eg you can select all the records in a calendar with the startdate greater then the first of the month and a startdate less then the end of the month but this is going to miss all multi-day appointments. Also in my example say I wanted to know if there where any appointments that where on the 5th then just looking at the start date of an appointment wouldn't necessarily tell me this because I could have a multiday event that started on the 4th and finished on the 6th. The other problem i faced is i wanted to show all the days where there was some appointments scheduled as bold and clickable trying to do this you also run into the same problem where appointments span Multiple days (Also a lot of advanced aggregate functions aren't available in Exoledb).

To solve this problem my solution was to use a sliding time window, so to get all the appointments for the month I had to query for all appointments with a enddate greater then the 1st of the month and a startdate that was less then the 1st day of next month. To work out if there were any appointments on each particular day I did a 31 repetition for next loop using a time window that spanned a 1 day and re-filtered the recordset for each repitition. (the logic sounds a bit weird but its one of those things you really need to think about but it does work and only requires one query of the Exchange Server). Then I just reused the array in the for next loop that generated the calendar

To feed my Asp calendar I packaged up the Exoledb code into a WSC com object and then created a wrapper that runs under an account that had rights to the calendar I wanted this page to access. I also created some click thoughs that would display the days appointments in a table on the right of the page. This still needs a fair bit of work but it works fine at the moment. I would have prefered to maybe use some inline xml so i didn't have to requery Exchange everytime i looked at a different day.

WSC object ..


<?xml version="1.0"?>
<component>

<registration
description="calfeed"
progid="calfeed.WSC"
version="1.00"
classid="{4414f884-d473-401a-8357-b899f3de8f31}"
>
</registration>

<public>
<method name="mailbox">
<PARAMETER name="MBname"/>
</method>
</public>

<implements type="ASP" id="ASP"/>

<script language="VBScript">
<![CDATA[

function mailbox(MBname)

set shell = createobject("wscript.shell")
strValueName = "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
minTimeOffset = shell.regread(strValueName)
toffset = datediff("h",DateAdd("n", minTimeOffset, now()),now())
dtListFrom = DateAdd("n", minTimeOffset, now())
gmttime = dateadd("h",toffset,now())
dtListTo = isodateit(dateserial(year(now()),month(dateadd("m",1,now())),1)& " " & timeserial(0,0,0))
dtListFrom = isodateit(dateserial(year(now()),month(now()),1) & " " & timeserial(0,0,0))
Set Rs = CreateObject("ADODB.Recordset")
set Rec = CreateObject("ADODB.Record")
Set Conn = CreateObject("ADODB.Connection")
CalendarURL = "http://yourserver/exchange/" & MBname & "/calendar"
Conn.Provider = "ExOLEDB.DataSource"
Rec.Open CalendarURL
Set Rs.ActiveConnection = Rec.ActiveConnection
Rs.Source = "SELECT ""DAV:href"", " & _
" ""urn:schemas:httpmail:subject"", " & _
" ""urn:schemas:calendar:dtstart"", " & _
" ""urn:schemas:calendar:dtend"", " & _
" ""urn:schemas:calendar:organizer"", " & _
" ""urn:schemas:calendar:location"", " & _
" ""DAV:contentclass"" " & _
"FROM scope('shallow traversal of """ & CalendarURL & """') " & _
"WHERE (""urn:schemas:calendar:dtend"" > CAST(""" & dtListFrom & """ as 'dateTime'))" & _
"AND (""urn:schemas:calendar:dtstart"" < CAST(""" & dtListTo & """ as 'dateTime'))"& _
" AND ""DAV:contentclass"" = 'urn:content-classes:appointment'" & _
"ORDER BY ""urn:schemas:calendar:dtstart"" ASC"

Rs.CursorLocation = 3 'adUseServer = 2, adUseClient = 3
Rs.CursorType = 3
Rs.Open
set mailbox = Rs
end function

function isodateit(datetocon)
strDateTime = year(datetocon) & "-"
if (Month(datetocon) < 10) then strDateTime = strDateTime & "0"
strDateTime = strDateTime & Month(datetocon) & "-"
if (Day(datetocon) < 10) then strDateTime = strDateTime & "0"
strDateTime = strDateTime & Day(datetocon) & "T" & formatdatetime(datetocon,4) &":00Z"
isodateit = strDateTime
end function


]]>
</script>

Calendar ASP page ....
<%
CD = request.querystring("cday")
set cfeed = createobject("calfeed.WSC")
set rs = cfeed.mailbox("yourmailbox")
set shell = createobject("wscript.shell")
strValueName = "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
minTimeOffset = shell.regread(strValueName)
toffset = datediff("h",DateAdd("n", minTimeOffset, now()),now())
dtListFrom = DateAdd("n", minTimeOffset, now())
redim myarray(3,31)
for i = 1 to 31
rs.filter = "urn:schemas:calendar:dtend > '" & dateadd("h",-toffset,dateserial(year(now()),month(now()),i))
& "' and urn:schemas:calendar:dtstart < '" & dateadd("h",-toffset,dateserial(year(now()),month(now()),i+1)) & "'"
myarray(1,i) = rs.recordcount
myarray(2,i) = dateadd("h",-toffset,dateserial(year(now()),month(now()),i))
myarray(3,i) = dateadd("h",-toffset,dateserial(year(now()),month(now()),i+1))
next
rs.filter = ""
%>
<html>

<head>
<meta name="GENERATOR" content="Microsoft FrontPage 6.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>New Page 1</title>
</head>

<body>

<br>
<table border="1" cellspacing="1" width="100%">
<tr>
<td width="151"><table border="0" id="table1" cellpadding="2" width="147">
<tr><b><% response.write "<td style=""padding: 0"" width=""112""
align=""center"" colspan=""7""><b><font face=""Arial"" color=""#000080"">" &
monthname(month(now())) & " " & Year(now()) &"</td>"
%></font></b> </tr>
<tr>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
S</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
M</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
T</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
W</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
T</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
F</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
S</td>
</tr>
<%
cdatefday = cdate(dateserial(year(now()),month(now()),"1"))
sday = weekday(cdatefday)
cmonth = month(now())
for x = 1 to 6
response.write "<tr>"
for i = 1 to 7
if cmonth = month(cdatefday) then
if sday =< i then
sday = 0
if myarray(1,day(cdatefday)) = 0 then
response.write "<td style=""padding: 0"" width=""16"" align=""center"">" &
day(cdatefday) & "</td>"
else
response.write "<td style=""padding: 0"" width=""16"" align=""center""><a
href=""caltest2.asp?cday=" & day(cdatefday) & """><b>" & day(cdatefday) & "</a></b></td>"
end if
cdatefday = dateadd("d",1,cdatefday)
else
response.write "<td style=""padding: 0"" width=""16"" align=""center""> </td>"

end if
else
response.write "<td style=""padding: 0"" width=""16"" align=""center""> </td>"

end if
next
response.write "</tr>"
next

%></td>
<td>&nbsp;</td>
</tr>
</table>
<td width="617"><table border="0" cellspacing="0" width="100%" id="table2" cellpadding="0"><tr>
<td width="154"><B>Start Date</B></td>
<td width="154"><B>End Date</B></td>
<td><B>Subject</B></td>
</tr>
<% If CD <> "" then
rs.filter = "urn:schemas:calendar:dtend > '" &
dateadd("h",-toffset,dateserial(year(now()),month(now()),CD)) & "' and urn:schemas:calendar:dtstart < '" & dateadd("h",-toffset,dateserial(year(now()),month(now()),CD+1)) & "'"
end if
while not rs.eof
response.write "<tr>" & vbcrlf
response.write "<td width=""154"">" & dateadd("h",toffset,rs.fields("urn:schemas:calendar:dtstart")) & "</td>" & vbcrlf
response.write "<td width=""154"">" &
dateadd("h",toffset,rs.fields("urn:schemas:calendar:dtend")) & "</td>" & vbcrlf
response.write "<td>" & rs.fields("urn:schemas:httpmail:subject") & "</td>" & vbcrlf
response.write "</tr>" & vbcrlf
rs.movenext
wend
%>
</table>



Friday, June 18, 2004

Simple Html Calendar VB script

One of the cool things that I like about blogging is the little calendar you see on left side of most blogs. They resemble a lot the calendars you see in Outlook and Outlook Web Access. I always thought they we some funky Activex control that you had to sell your first born to buy but they are actually really easy to create using a little bit of script and html.

The hardest thing in this script was working out what week day the first day of the month is fortunately there are a couple of functions in VBS that help you out. This is a ASP sample that displays a small calendar

The next step is to see if I can get it to use a Exoledb script as a source for the calendar.


<table border="0" id="table1" cellpadding="2" width="147">
<tr><b><% response.write "<td style=""padding: 0"" width=""112"" align=""center"" colspan=""7"">
<b><font face=""Arial"" color=""#000080"">" & monthname(month(now())) & " " & Year(now()) & "</td>"
%></font></b> </tr>
<tr>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
S</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
M</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
T</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
W</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
T</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
F</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
S</td>
</tr>
<%
cdatefday = cdate(dateserial(year(now()),month(now()),"1"))
sday = weekday(cdatefday)
cmonth = month(now())
for x = 1 to 6
response.write "<tr>"
for i = 1 to 7
if cmonth = month(cdatefday) then
if sday =< i then
sday = 0
response.write "<td style=""padding: 0"" width=""16"" align=""center"">" & day(cdatefday) & "</td>"
cdatefday = dateadd("d",1,cdatefday)
else
response.write "<td style=""padding: 0"" width=""16"" align=""center""> </td>"
end if
else
response.write "<td style=""padding: 0"" width=""16"" align=""center""> </td>"
end if
next
response.write "</tr>"
next
%>



Finding Unused Mailboxes with CDO 1.2

A while ago I posted this script on OutlookExchange that uses Exoledb to find unused mailboxes on a Exchange 2000 server by looking at the unread mail count in the inbox for the last 50 days. Since then I've have a few questions for people wanting to know if they could do this also in Exchange 5.5 mainly to assist in migrations and cleanups. The answer is yes you can but not with Exoledb which is only available on Exchange 2000 and up, what you can use is CDO 1.2 to do something similar.

Another good thing about using CDO 1.2 to do this is you can go a bit further then I did with the simple Exoledb sample by using some of CDO 's cool little built in methods. This is an example of a CDO script that will display the received time of the newest email in the inbox, the sent time of the last mail sent from this mailbox and the unread count for the last 50 days. It logs on to a mailbox using a dynamic profile you supply the alias name as a command line parameter and you need to hardcode the servername in the script.


accountname = WScript.Arguments(0)
set objSession = CreateObject("MAPI.Session")
strProfile = "yourserver" & vbLf & accountname
objSession.Logon "","",False,True,0,True,strProfile
set objFolder1 = objSession.Inbox
set objMsgs1 = objFolder1.Messages
set objMsg1 = objMsgs1.Getlast
set objFolder = objSession.GetDefaultFolder(3)
set objMsgs = objFolder.Messages
set objMsg = objMsgs.Getlast
if objMsg1 is nothing then
wscript.echo "Last Recieved" & "," & accountname & "," & "No Messages"
else
wscript.echo "Last Recieved" & "," & accountname & "," & objMsg1.TimeSent
end if
if objMsg is nothing then
wscript.echo "Last Sent" & "," & accountname & "," & "No Messages"
else
wscript.echo "Last Sent" & "," & accountname & "," & objMsg.TimeSent
end if
objFolder1.Messages.Filter.Unread = False
set objMsgFilter = objMsgs1.Filter
objMsgFilter.Unread = True
objMsgFilter.TimeFirst = now()-50
wscript.echo "Number of Unread" & "," & accountname & "," & objMsgs1.count
objSession.Logoff

Thursday, June 17, 2004

Public folder RSS Feed Event sink

I've gone a bit RSS mad of late for today's edition I created an Event sink for public folders so when a new mail or post arrives into that folder it will fire a script that updates a feed with the last 7 days of posts. I guess the cool thing here is you can stick this on all the important public folders in your org and then use one web page to aggregate across all the feeds and present this back to the user as one single web page. Also it lets people subscribe to folders and receive notification of updates etc.



Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)

on error resume next
set DispEvtInfo = pEventInfo
set ADODBRec = DispEvtInfo.EventRecord
set objdom = CreateObject("MICROSOFT.XMLDOM")
Set objField = objDom.createElement("rss")
Set objattID = objDom.createAttribute("version")
objattID.Text = "2.0"
objField.setAttributeNode objattID
objDom.appendChild objField
Set objField1 = objDom.createElement("channel")
objfield.appendChild objField1
Set objField3 = objDom.createElement("title")
objfield3.text = "Public Folder Feed"
objfield1.appendChild objField3
Set objField4 = objDom.createElement("link")
objfield1.appendChild objField4
Set objField5 = objDom.createElement("description")
objfield5.text = "Public Folder Feed For Path"
objfield1.appendChild objField5
Set objField6 = objDom.createElement("language")
objfield6.text = "en-us"
objfield1.appendChild objField6
Set objField7 = objDom.createElement("lastBuildDate")
objfield7.text = formatdatetime(now(),1) & " " & formatdatetime(now(),4) & ":00 GMT"
objfield1.appendChild objField7
Set Rs = CreateObject("ADODB.Recordset")
Set fso = CreateObject("Scripting.FileSystemObject")
Set msgobj = CreateObject("CDO.Message")
tyear = year(now()-7)
tmonth = month(now()-7)
if tmonth < 10 then tmonth = 0 & tmonth
stday = day(now()-7)
if stday < 10 then stday = 0 & stday
sttime = formatdatetime(now1,4)
qdatest = tyear & "-" & tmonth & "-" & stday & "T"
qdatest1 = qdatest & sttime & ":" & "00Z"
set Rec = CreateObject("ADODB.Record")
set Rec1 = CreateObject("ADODB.Record")
Set Conn = CreateObject("ADODB.Connection")
mailboxurl = ADODBRec.fields("Dav:parentname")
Conn.Provider = "ExOLEDB.DataSource"
Rec.Open mailboxurl, ,3
SSql = "SELECT ""DAV:href"", ""DAV:contentclass"", ""urn:schemas:httpmail:textdescription"", ""urn:schemas:httpmail:datereceived"", "
SSql = SSql & """urn:schemas:httpmail:fromemail"", ""urn:schemas:httpmail:subject"", ""DAV:ishidden"" "
Ssql = SSql & " FROM scope('shallow traversal of """ & mailboxurl & """') "
SSql = SSql & " WHERE (""urn:schemas:httpmail:datereceived"" > CAST(""" & qdatest1 & """ as 'dateTime')) AND ""DAV:isfolder"" = false"
Rs.CursorLocation = 3 'adUseServer = 2, adUseClient = 3
Rs.CursorType = 3
rs.open SSql, rec.ActiveConnection, 3
if Rs.recordcount <> 0 then
Rs.movefirst
while not rs.eof
if rs.fields("DAV:ishidden") = 0 then
Set objField2 = objDom.createElement("item")
objfield1.appendChild objField2
Set objField8 = objDom.createElement("title")
objfield8.text = rs.fields("urn:schemas:httpmail:subject")
objfield2.appendChild objField8
Set objField9 = objDom.createElement("link")
objfield9.text = "http://mgnms01/public" _
& right(Rs.fields("Dav:href"),(len(Rs.fields("Dav:href"))-instr(Rs.fields("Dav:href"),"/Public Folders/"))-14)
objfield2.appendChild objField9
Set objField10 = objDom.createElement("description")
objfield10.text = Rs.fields("urn:schemas:httpmail:textdescription")
objfield2.appendChild objField10
Set objField11 = objDom.createElement("author")
objfield11.text = rs.fields("urn:schemas:httpmail:fromemail")
objfield2.appendChild objField11
Set objField12 = objDom.createElement("pubDate")
objfield12.text = formatdatetime(rs.fields("urn:schemas:httpmail:datereceived"),1) _
& " " & formatdatetime(rs.fields("urn:schemas:httpmail:datereceived"),4) & ":00 GMT"
objfield2.appendChild objField12
set objfield2 = nothing
set objfield8 = nothing
set objfield9 = nothing
set objfield10 = nothing
set objfield11 = nothing
end if
rs.movenext
wend
end if
rs.close
Set objPI = objDom.createProcessingInstruction("xml", "version='1.0'")
objDom.insertBefore objPI, objDom.childNodes(0)
objdom.save("d:\inetpub\wwwroot\pubfolder1.xml")

End Sub

Wednesday, June 16, 2004

RSS Feed for Outgoing Mail

Further to my post yesterday with the IMF Blocked mail RSS feed script which I found quite useful I decided to create a feed for all outgoing email. To do this I used tracking ID 1020 which gets logged when mail is transferred to another server and then did a filter using a if statement to see if the mail is coming from the sending domain. The changes I made are as follows

Changed the Feed Title and Description

Set objField3 = objDom.createElement("title")
objfield3.text = "Outbound Mail Feed"

Set objField5 = objDom.createElement("description")
objfield5.text = "Outbound Mail Feed"

Changed the time scope of the script from 1 day to 2 hours by changing the following line

dtListFrom = DateAdd("h",-2,dtListFrom)

Changed the Query to look for 1020 message ID's

str = "Select * FROM Exchange_MessageTrackingEntry where entrytype = '1020' and OriginationTime > '" & strStartDateTime & "'"

Added the following if block inside the for next loop

For Each objEvent in colLoggedEvents
for i = 1 to objEvent.RecipientCount
if instr(objEvent.Senderaddress,"@mydomain.com.au") then .........

end if
next
Next

Then the last change was to create a new feed file to subscribe too.

objdom.save("\\mgnfs01\e$\inetpub\wwwroot\intranet\outbound.xml")

Then I scheduled it to run every hour because my news aggregator runs every hour the 2 hour period should be enough to pick up all new posts.

For small sites (especially those running SBS) this might be a good way to provide the owners with an easy way to veiw all mail thats being send out.

Tuesday, June 15, 2004

Exchange Message Tracking Logs Rss Feed Script

To do Message Tracking Log Reporting I wrote a little application using a Access database and some ASP pages which I posted up on OutlookExchange a while ago. This works pretty well but when it comes to constant monitoring of a mailbox it can be a little bit of a pain to keep logging on and checking.

RSS offers a real alternative for this type of functionality, it can give users the ability to be able to subscribe to a feed of new items going into a common mailbox. To create a rss feed its just a simple manner of creating a xml file that is formatted in the expected RSS format which can be found here.

As a first go at this what I did was take the my spam reporting script for this post and instead of creating a Html table as Ive done in this previous script what I do instead is produce a RSS feed file of all the SPAM that has been deleted via the IMF. Then all you need to do is publish this xml file on a web server and then subscribe to the feed in your aggregator of choice.

What I want to do with this is actually be able to aggregate the whole log and maybe create a separate feed for each user and then store that feed in their mailbox. Then users who have access to another person mailbox can then go in and subscribe to the feed so they can then receive updates of mail going in and out of that mailbox. Needs some work though.


set objdom = CreateObject("MICROSOFT.XMLDOM")
Set objField = objDom.createElement("rss")
Set objattID = objDom.createAttribute("version")
objattID.Text = "2.0"
objField.setAttributeNode objattID
objDom.appendChild objField
Set objField1 = objDom.createElement("channel")
objfield.appendChild objField1
Set objField3 = objDom.createElement("title")
objfield3.text = "IMF SPAM Report Feed"
objfield1.appendChild objField3
Set objField4 = objDom.createElement("link")
objfield1.appendChild objField4
Set objField5 = objDom.createElement("description")
objfield5.text = "IMF SPAM Report Feed"
objfield1.appendChild objField5
Set objField6 = objDom.createElement("language")
objfield6.text = "en-us"
objfield1.appendChild objField6
Set objField7 = objDom.createElement("lastBuildDate")
objfield7.text = formatdatetime(now(),1) & " " & formatdatetime(now(),4) & ":00 GMT"
objfield1.appendChild objField7
strComputer = "."
set shell = createobject("wscript.shell")
strValueName = "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
minTimeOffset = shell.regread(strValueName)
toffset = datediff("h",DateAdd("n", minTimeOffset, now()),now())
dtListFrom = DateAdd("n", minTimeOffset, now())
dtListFrom = DateAdd("d",-1,dtListFrom)
strStartDateTime = year(dtListFrom)
if (Month(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Month(dtListFrom)
if (Day(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Day(dtListFrom)
if (Hour(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Hour(dtListFrom)
if (Minute(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Minute(dtListFrom)
if (Second(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Second(dtListFrom) & ".000000+000"
Set objWMIService = Getobject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\MicrosoftExchangeV2")
qstr = "Select * FROM Exchange_MessageTrackingEntry where entrytype = '1039' and OriginationTime > '" & strStartDateTime & "'"
Set colLoggedEvents = objWMIService.ExecQuery(qstr,,48)
spamcount = 0
spambytes = 0
For Each objEvent in colLoggedEvents
for i = 1 to objEvent.RecipientCount
OTime = objEvent.OriginationTime
odate = formatdatetime(cdate(DateSerial(Left(OTime, 4), Mid(OTime, 5, 2), Mid(OTime, 7, 2))),1) & " " _
& formatdatetime(timeserial(Mid(OTime, 9, 2),Mid(OTime, 11, 2),Mid(OTime,13, 2)),4) & ":00 GMT"
Set objField2 = objDom.createElement("item")
objfield1.appendChild objField2
Set objField8 = objDom.createElement("title")
objfield8.text = objEvent.clientip & " " & objEvent.SenderAddress & " " & objEvent.Subject & " " & objEvent.size
objfield2.appendChild objField8
Set objField9 = objDom.createElement("link")
objfield9.text = ""
objfield2.appendChild objField9
Set objField10 = objDom.createElement("description")
objfield10.text = objEvent.clientip & " " & objEvent.SenderAddress & " " & objEvent.RecipientAddress((i-1)) _
& " " & objEvent.Subject & " " & objEvent.size
objfield2.appendChild objField10
Set objField11 = objDom.createElement("author")
objfield11.text = objEvent.RecipientAddress((i-1))
objfield2.appendChild objField11
Set objField12 = objDom.createElement("pubDate")
objfield12.text = odate
objfield2.appendChild objField12
set objfield2 = nothing
set objfield8 = nothing
set objfield9 = nothing
set objfield10 = nothing
set objfield11 = nothing
next
next

Set objPI = objDom.createProcessingInstruction("xml", "version='1.0'")
objDom.insertBefore objPI, objDom.childNodes(0)

objdom.save("c:\inetpub\wwwroot\spam.xml")

Wednesday, June 09, 2004

Setting OOF status and Text using a OWA Script

I created this blog entry a couple of days ago about using the Microsoft.XMLHTTP to do some automation scripting with exchange in regards to adding entries into the junk email whit lists. This same method can also be used to set a variety of other settings as well, one of these is a user OOF ( Out of office ) setting. You can also set this via a script using CDO 1.2 and also via Exoledb/WebDAV but this does offer a simple alternative. To set the OOF setting of a user you just issue the following commands

Cmd=options
OofReply=Im Out of the Office
OofState=1

An example of using this in a script would be

szXml = ""
szXml = szXml & "Cmd=options" & vbLf
szXml = szXml & "OofReply=Im Out of the Office" & vbLf
szXml = szXml & "OofState=1" & vbLf

Set oXmlHttp = CreateObject("Microsoft.XMLHTTP")
oXmlHttp.Open "POST", "http://youserver/exchange/youruser/", False, "", ""
oXmlHttp.setRequestHeader "Accept-Language:", "en-us"
oXmlHttp.setRequestHeader "Content-type:", "application/x-www-UTF8-encoded"
oXmlHttp.setRequestHeader "Content-Length:", Len(szXml)
oXmlHttp.Send szXml

Wscript.echo oXmlHttp.responseText

Post IMF Archiving Event Sink

Once the IMF has achieved a message this is pretty final in regards to the delivery of this message, but it doesn't have to be so what you can do is create a WMI consumer on the archive directory so every time a message gets archived it will then trigger an event.  After this you can then open the new mail that was just archived using CDO have a look at who it was going to or do further inspection on the content and if you think that this message should have been delivered move it back into the pickup directory and have it delivered. The logic and things you can do with this is up to your own imagination one simple example is if you have an account that you want to allow all mail though no matter what this script will check the x-receiver field if the mail is going to that user it will then move the email into the pickup directory. You can set this up as a permanent consumer using a Mof file or my preference is to use Srvany and create a service that this script runs as.


strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN 10 WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""c:\\\\program files\\\\exchsrvr\\\\mailroot\\\\vsi 1\\\\ucearchive""'")
Do
Set objLatestEvent = colMonitoredEvents.NextEvent
set msgobj = createobject("CDO.Message")
fname = objLatestEvent.TargetInstance.PartComponent
set stm = createobject("ADODB.Stream")
stm.open
fname = replace(fname,"\\","\")
fname = right(fname,len(fname) - instr(fname,chr(34)))
fname = replace(fname,chr(34),"")
stm.loadfromfile fname
msgobj.datasource.openobject stm, "_Stream"
wscript.echo msgobj.fields("urn:schemas:mailheader:x-receiver")
if msgobj.fields("urn:schemas:mailheader:x-receiver") = "youruser@yourdomain.com" then
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.movefile fname, replace(fname,"ucearchive","pickup")
Wscript.echo fname
end if
set msgobj = nothing
set stm = nothing
Loop

Monday, June 07, 2004

Importing Entries into Safe Senders, Safe Recipients and Blocked Senders via Script

Outlook 2003 and OWA (Exchange 2003) have the ability to create and maintain White/Black lists that work in conjunction with the IMF to filter Spam.Now that I'm using the IMF to do my spam management theses personal white lists have come up as an issue. Sometimes its necessary to globally white list an address or domain for all users or upload a number of entries into one users whitelist or ensure that as new mailboxes get created any necessary white-list entries get created for users. So a script or programmatic way to do this becomes a bit of a necessity. From a server perspective the lists are all stored in a binary property on a message in the users inbox (junk E-mail rule), so you can use Exoledb and Webdav to get at this property but because its just a binary blob of data decoding and/or adding to it from a script would be quite hard (not that I didn't try).

One solution that I found that works is to re-use some OWA commands in a script using the XML parser (Microsoft.XMLHTTP). Q290591 describes a method you can use to post information to web pages using the XMLHTTP object. What you can do is take this and apply it to OWA, Eg: When you add users to the safe senders list in OWA it posts the following data to the web server.

"cmd=savejunkemailrule"
"addtots=user@domain;"

For Safe Recipients its "addtotr=user@domain;" and for Blocked Senders it "addtojs=user@domain;" (I was so disappointed it wasn't addtobs ).

So to create a script that adds 3 entries to the Trusted Senders list and also enables the junk email filtering check box in OWA the script looks like below.
Note this only works if you aren't using FBA on your mailbox server,

xmlstr = ""
xmlstr = xmlstr & "Cmd=options" & vbLf
xmlstr = xmlstr & "junkemailstate=1" & vbLf
xmlstr = xmlstr & "cmd=savejunkemailrule" & vbLf
xmlstr = xmlstr & "addtots=user@domain;@domain1.com;@domain2.com;"
Set ObjxmlHttp = CreateObject("Microsoft.XMLHTTP")
ObjxmlHttp.Open "POST", "http://yourserver/exchange/yourmailbox/", False, "", ""
ObjxmlHttp.setRequestHeader "Accept-Language:", "en-us"
ObjxmlHttp.setRequestHeader "Content-type:", "application/x-www-UTF8-encoded"
ObjxmlHttp.setRequestHeader "Content-Length:", Len(xmlstr)
ObjxmlHttp.Send xmlstr
Wscript.echo ObjxmlHttp.responseText

Thursday, June 03, 2004

Copying RTF messages from Mailboxes to Public Folders

Copying messages from a mailbox to a public folder programmatically has never been a really easy task in Exchange, copying within one mailbox is okay you can use the basic ADO copy record and move record but between mailboxes or mailbox to public folder you start to hit some issues.

One method that I found that works is to use the message stream object, this gets you a serialized version of the message that is easier to deal with. The problem with this method is that if the mail has any Rich Text formatting (or any other custom MAPI properties) then these properties don't get copied with the stream (what usually happens is the email just gets set to HTML). To solve this problem you need to look at which MAPI properties you need to copy over and copy these manually in your code. For example my problem was that i needed to copy the RTF formatting of a message over when I copied an item between a mailbox and the public folder. Using MDBvu32 to examine a message I found the MAPI property PR_RTF_COMPRESSED which contains the RTF version of the message text. You can use this property in the field object of a message by using its Hex value which looks like http://schemas.microsoft.com/mapi/proptag/x10090102. So combining this with the following script solved my problem Eg.

set msgobj = createobject("CDO.Message")
set msgobj1 = createobject("CDO.Message")
set stm = CreateObject("ADODB.Stream")
msgobj.datasource.open "file://./backofficestorage/yourdomain.com/MBX/yourmailbox/inbox/email.eml",,3
set stm = msgobj.getstream()
msgobj1.datasource.openobject stm, "_Stream"
rtfbody = msgobj.fields("http://schemas.microsoft.com/mapi/proptag/x10090102")
msgobj1.fields("http://schemas.microsoft.com/mapi/proptag/x10090102") = rtfbody
msgobj1.fields("http://schemas.microsoft.com/exchange/outlookmessageclass") ="IPM.NOTE"
msgobj1.fields.update
msgobj1.datasource.savetocontainer "file://./backofficestorage/yourdomain.com/public folders/test/"

Tuesday, June 01, 2004

IMF message tracking ID's and Spam Report script

If you have Message Tracking Logging enabled on your server then Exchange records details about the message transfer process into the message tracking logs which can then be searched via Exchange System Manager - Message Tracking Center. A full list of Tacking ID and descriptions for Exchange 2003 can be found in the Exchange FAQ . With the release of the IMF there are now some new Tracking ID's that get logged when the IMF takes action on a message at the gateway level. The ID's look like this

1039 SMTP:Message Deleted by Intelligent Message Filtering
1040 SMTP:Message Rejected by Intelligent Message Filtering
1041 SMTP:Messgae Archived by Intelligent Message Filtering

Depending on how you have your Gateway actions set you will get 1 or 2 of theses events logged when a gateway action is performed , Eg if you have your gateway action set to archive you get a 1041 logged and then a 1039 logged.
Apart from System Manager the Message tracking logs can be accessed via WMI using the Exchange_MessageTrackingEntry Class which is part of the ROOT\MicrosoftExchangeV2 Namespace.

As part of my daily Sys-Admin duties I wanted to be able to check what emails the IMF took action on over the past day, so what I came up with is a script that uses a WMI WQL query of all the 1039 events for the past day, puts the results in a HTML table and then emails me. The script I used is below - There are some time conversion routines to convert UTC times to local and also construct the time variable format required for WQL. The only other thing of note is that I have subject logging enable on my server which the script expects. To use it I just created a scheduled task that runs the script once a day in the morning.

Its had about a day of testing (the joys of blogging) and worked okay last night Enjoy.


SpamReport = "<table border=""1"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & vbcrlf
SpamReport = SpamReport & "<table border=""1"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & vbcrlf
SpamReport = SpamReport & " <tr>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">Time</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">Ip</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">From</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">Sent-TO</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">Subject</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">Size</td>" & vbcrlf
SpamReport = SpamReport & "</tr>" & vbcrlf
strComputer = "."
set shell = createobject("wscript.shell")
strValueName = "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
minTimeOffset = shell.regread(strValueName)
toffset = datediff("h",DateAdd("n", minTimeOffset, now()),now())
dtListFrom = DateAdd("n", minTimeOffset, now())
dtListFrom = DateAdd("d",-1,dtListFrom)
strStartDateTime = year(dtListFrom)
if (Month(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Month(dtListFrom)
if (Day(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Day(dtListFrom)
if (Hour(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Hour(dtListFrom)
if (Minute(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Minute(dtListFrom)
if (Second(dtListFrom) < 10) then strStartDateTime = strStartDateTime & "0"
strStartDateTime = strStartDateTime & Second(dtListFrom) & ".000000+000"
Set objWMIService = Getobject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\MicrosoftExchangeV2")
qstr = "Select * FROM Exchange_MessageTrackingEntry where entrytype = '1039' and OriginationTime > '" & strStartDateTime & "'"
Set colLoggedEvents = objWMIService.ExecQuery(qstr,,48)
spamcount = 0
spambytes = 0
For Each objEvent in colLoggedEvents
for i = 1 to objEvent.RecipientCount
OTime = objEvent.OriginationTime
odate = dateadd("h",toffset,cdate(DateSerial(Left(OTime, 4), Mid(OTime, 5, 2), Mid(OTime, 7, 2)) _
& " " & timeserial(Mid(OTime, 9, 2),Mid(OTime, 11, 2),Mid(OTime,13, 2))))
SpamReport = SpamReport & " <tr>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">" & formatdatetime(odate,4) & "</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">" & objEvent.clientip & "</td>"& vbcrlf
SpamReport = SpamReport & "<td align=""center"">" & objEvent.SenderAddress & "</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">" & objEvent.RecipientAddress((i-1)) & "</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">" & objEvent.Subject & "</td>" & vbcrlf
SpamReport = SpamReport & "<td align=""center"">" & objEvent.size & "</td>" & vbcrlf
SpamReport = SpamReport & "</tr>" & vbcrlf
spamcount = spamcount + 1
spambytes = spambytes + objEvent.size
next
next
SpamReport = SpamReport & "</table>" & vbcrlf
REm Email Bit
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "spamreport@yourdomain.com.au"
objEmail.To = "youremail@yourdomain.com"
objEmail.Subject = "Spam Report for " & formatdatetime(now(),2) & " " &spamcount & " Mails Blocked " _
& (spambytes\1024) & " KB"
objEmail.htmlbody = SpamReport
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YourServer"
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send