connect to exchange 2007 mailbox and alert unread and total recieved for day

Author Message
faulkkev

  • Total Posts : 593
  • Scores: 13
  • Reward points : 0
  • Joined: 11/1/2005
  • Location: Kansas City, MO
  • Status: offline
connect to exchange 2007 mailbox and alert unread and total recieved for day Thursday, November 17, 2011 5:22 AM (permalink)
0
I am a bit stumped how to do this.   I have found a script that works on exchange 2003 but not 2007.  Anyone have any idea how to make this work or other suggestions.  I saw some ews soap code but it was a bit much for me to understand.  In our enviornment we use owa as follows.   https://owa.externalDomainname.com/owa.      I am hoping some url password auth is all the script needs.  OWA does not allow passthru and is in form based mode.  Thanks for any suggestions.  My goal is to detect all unread emails and total meeting current date for the day if possible.  getting into owa is the big step though. It appears to be a login time out probably due to forms based.
  
  
 
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
 
<message edited by faulkkev on Thursday, November 17, 2011 5:31 AM>
 
#1

    Online Bookmarks Sharing: Share/Bookmark

    Jump to:

    Current active users

    There are 0 members and 1 guests.

    Icon Legend and Permission

    • New Messages
    • No New Messages
    • Hot Topic w/ New Messages
    • Hot Topic w/o New Messages
    • Locked w/ New Messages
    • Locked w/o New Messages
    • Read Message
    • Post New Thread
    • Reply to message
    • Post New Poll
    • Submit Vote
    • Post reward post
    • Delete my own posts
    • Delete my own threads
    • Rate post

    2000-2012 ASPPlayground.NET Forum Version 3.9