HOWTO: WebDav: Exchange 2003: Poll for unread emails & notify admin if a predefined level is reached

I think you may find it useful as well. I wrote this script to monitor a particular mailbox for unread emails count in a particular folder and notify people about it. It could be useful to monitor a service mailbox and make sure it does not have any email unprocessed after a certain period of time. You may schedule this script as job to run every hour or so and notify you if there were any unread emails pending in the inbox.

 Const strServer = "ExchangeServerName"                            ' Exchange 2003 Server's HOSTNAME/IPADDRESS

Const strDomain = "ExchangeLab"                        ' Credentials to login to mailbox
Const strUser = "Administrator"                        ' It could be credentials for the same mailbox
Const strPass = "********"                            ' or the credentials of a service account which has access to all mailboxes

Const strMailBox = "Administrator"                    ' Mailbox alias to login to
Const strFrom = "administrator@exchangelab.com"        ' From address of sender, ideally should be same as the Mailbox
Const strTo = "administrator@exchangelab.com"        ' Email sent TO
Const strSubject = "Unread mails alert!"            ' Email's subject
Const strBody = "You have {X} unread emails"         ' leave the {X} as is and this will be replaced with the actual number of unread message 
Const SSL_Enabled = ""                                ' change this to "s" if you want to enable SSL (HTTPS)
Const MaxUnreadAllowed = 10                            ' change it to maximum unread allowed in an inbox

Const strLogFilePath = "C:\UnreadEmailMonitor.log"    ' Change to the file path where you want to save the log


Dim xDoc
Dim xNodes
Dim strURL
Dim strResponse
Dim HttpWebRequest
Dim strXMLRequest
Dim strUnreadCount

strXMLRequest = "<?xml version=""1.0""?>"
strXMLRequest = strXMLRequest + "<D:propfind xmlns:D=""DAV:"" xmlns:z=""urn:schemas:httpmail:"">"
strXMLRequest = strXMLRequest + "<D:prop><z:unreadcount/></D:prop>"
strXMLRequest = strXMLRequest + "</D:propfind>"

strURL = "http" & SSL_Enabled & "://" & strServer & "/Exchange/" & strMailBox & "/Inbox"

Set HttpWebRequest = CreateObject("microsoft.xmlhttp")
Set xDoc = CreateObject("MSXML.DOMDocument")

HttpWebRequest.open "PROPFIND", strURL, False, strUser, strPass
HttpWebRequest.setRequestHeader "Content-type:", "text/xml"
HttpWebRequest.send strXMLRequest

WriteLog "Polling unread count from mailbox : " & strMailBox

If (HttpWebRequest.Status >= 200 And HttpWebRequest.Status < 300) Then
   WriteLog "Success downloading mailbox data"
ElseIf HttpWebRequest.Status = 401 Then
   WriteLog "You don't have permission to connect to this mailbox: " & strMailBox
Else
   WriteLog "Error downloading mailbox data. Status: " & HttpWebRequest.Status & ": " & HttpWebRequest.statusText
End If

strResponse = HttpWebRequest.responseText


If xDoc.loadXML(strResponse) Then

Dim startPos
Dim endPos
Dim ns

    endPos = InStr(strResponse, "=""urn:schemas:httpmail:")
    startPos = InStrRev(strResponse, "xmlns:", endPos) + 6
    ns = Mid(strResponse, startPos, endPos - startPos)
    strUnreadCount = xDoc.selectSingleNode("//" & ns & ":unreadcount").Text
End If

If strUnreadCount > MaxUnreadAllowed Then 

WriteLog "Unread emails found: " & strUnreadCount & " , sending mail to " & strTo

strURL = "http" & SSL_Enabled & "://" & strServer & "/Exchange/" & strUser & "/##DavMailSubmissionURI##"
HttpWebRequest.open "PUT", strURL, False, strDomain & "\" & strUser, strPass

        
strXMLRequest = "From: " & strFrom & vbNewLine & _
"To: " & strTo & vbNewLine & _
"Subject: " & strSubject & vbNewLine & _
"Date: " & Now() & vbNewLine & _
"X-Mailer: Mailbox Polling Application" & vbNewLine & _
"MIME-Version: 1.0" & vbNewLine & _
"Content-Type: text/html" & vbNewLine & _
"Charset = ""iso-8859-1""" & vbNewLine & _
"Content-Transfer-Encoding: 7bit" & vbNewLine & vbNewLine & _
Replace(strBody, "{X}", strUnreadCount)

HttpWebRequest.setRequestHeader "Translate", "f"
HttpWebRequest.setRequestHeader "Content-Type", "message/rfc822"
HttpWebRequest.setRequestHeader "Content-Length", "" & Len(strXMLRequest)
HttpWebRequest.send strXMLRequest
    
 If (HttpWebRequest.Status >= 200 And HttpWebRequest.Status < 300) Then
   WriteLog "Message successfully sent."
 ElseIf HttpWebRequest.Status = 401 Then
   WriteLog "You don't have permission to send the Message."
 Else
   WriteLog "Message not successfully sent. Status: " & HttpWebRequest.Status & ": " & HttpWebRequest.statusText
 End If
End If

 
Private Sub WriteLog(ByVal sText)
    Dim objFSO
    Dim objTextFile
    
    Const ForAppending = 8
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTextFile = objFSO.OpenTextFile(strLogFilePath, ForAppending, True)
    
    ' Write a line.
    objTextFile.Write (sText & vbCRLFde)

    objTextFile.Close
    'objTextFile.Close

End Sub 
 

Comments

• Anonymous
  August 16, 2009
  Can you please translate your code to c#?

• Anonymous
  October 13, 2009
  Can you please let me know how to use this code? habibalby@gmail.com

• Anonymous
  February 28, 2011
  Looks like some of it is cut off because of the frame for the website. I had to pull the full code from the source... Just sayin'

• Anonymous
  May 05, 2011
  this would be a very useful function for us if it would work with Exchange 2010. do you have a script for that? could you email me serrato01 gmail.com

• Anonymous
  May 05, 2011
  @serrato01 You can use EWS to do the very much similar job, I will try and blog the same.