Environment: Windows Server, Exchange, EAS, vb-script
Description: This script runs weekly and recaps a users email EAS detail. It is meant to give them a quick snap-shot of their account and show them their largest email attachments. This report is meant to help make mailbox's self-managed, and works in conjunction with nightly quota notification: EASnearquotaemail.vbs.
Features:
- Cascading Style Sheet
- HTML constructed
- DEBUG feature
- Errors write to application event log
- Database driven using ADO
Sample Report:
Code Listing
'=========================================================================
' FILE: EASUsageAudit.vbs
' AUTHOR: Robert Lawson
' COMPANY: Soka University of America
' DATE: 6/01/2006 Robert Lawson, Creation Date
' 11/29/2006 Robert Lawson General update ready for production
' 12/13/2006 Robert Lawson Added email send/receive size
' 12/21/2006 Robert Lawson Converted to XHTML
' 11/12/2007 Robert Lawson Added VIEW_STORAGE_BY_USER_REF2 for # and usage,
' this is what is used to enforce quota.
' 04/09/2008 Robert Lawson Skip if error 438 for send mail
' COMMENT: Audit EAS Usage and notification
' - Relies heavily t-sql views: VWEASUserQuotaUsage and VWEASUserTopMsgs
' - Server run on has to be allow SMTP relay on Exchange
'=========================================================================
option explicit
On Error Resume Next
const conScriptName = "EASUsageAudit.vbs"
const conSendMail = FALSE ' TRUE = will send email, FALSE=will not
strCSSfile = "C:\data\vbscript\EASUsageAuditCSS.html"
const conDEBUG = TRUE ' TRUE = SQL and displays, FALSE= full SQL and no displays
Dim objShell, strMsg, intLoc
Dim strCSSfile, strHTML, strHTMLCSS
Dim objFile, fso
Dim objConn, objRS, objRS2, objRS3, strSQL, strConn
Dim numQuota, numMsgSize, numCount, numUsers, numPctUsed, numSendSize, numReceiveSize
Dim numREF_COUNT, numUNCOMPRESSEDSIZESUM, numCOMPRESSEDSIZESUM
Dim strName, strEmail, strSize, strLimit, strCount
Dim strDateTime, strMailDate, strMailSize, strMailFrom, strMailSubject, strMailFolder
Dim strMailBody, strUSERID, strDetail, strQuotaDesc, strPctUsed, strSendSize, strReceiveSize
Dim iMsg, iConf, Flds
Dim strTo, strBCC, strCC, strFrom, strSubject, strTextBody
Const conEASQuotaUnlimited = -1
Const conMaxExchangeAttachment = 10 ' MB
Const conMaxEmailDetail = " Top 20 "
' Do not set your smtp server information here.
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing", _
cdoSendUsingPort = 2, _
cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const conSMTPserver = "smtp.campus.edu"
Const conFromUser = "EmailNotification@campus.edu" ' valid email if you want user to reply
Const conEmailAdminUser = "robert.lawson@campus.edu" ' comma seperated
Const ForReading = 1 ' FSO
numSendSize = 20 ' MB, ****** get from Exchange, when time
numReceiveSize = 20 ' MB, ****** get from Exchange, when time
' ============================================================
' Setup
' ============================================================
Set objShell = CreateObject( "WScript.Shell" )
' Write event log that you started
strMsg = "BEGIN: " & conScriptName
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg
' DB stuff
Set objConn = CreateObject("ADODB.Connection")
Set objRS = CreateObject("ADODB.Recordset")
Set objRS2 = CreateObject("ADODB.Recordset")
Set objRS3 = CreateObject("ADODB.Recordset")
strConn = "Provider=SQLOLEDB; SERVER=ServerName; DATABASE=dbName;Integrated Security = SSPI"
objConn.Open strConn
' Email stuff (SMTP)
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Fields.Item(cdoSendUsingMethod) = cdoSendUsingPort
iConf.Fields.Item(cdoSMTPServer) = conSMTPserver
iConf.Fields.Update
' ============================================================
' Load initial XHTML: CSS
' ============================================================
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFile = fso.OpenTextFile(strCSSfile, ForReading)
if objFile > 0 then
strHTMLCSS = objFile.ReadAll
'if conDEBUG then Wscript.Echo "+objFile = " & strHTML
else
Wscript.Echo conScriptName & ". ERROR: Unable to open CSS file: " & strCSSfile
wscript.quit
end if
' ============================================================
' Get user's, then detail and email'em
' ============================================================
strSQL = "SELECT USERID, UserName, QuotaSize, QuotaType, Email, MsgCount, MsgSize " & _
"FROM VWEASUserQuotaUsage"
if conDEBUG then strSQL = strSQL & " WHERE USERID = 7" ' ******** DEBUG ************
if conDEBUG then Wscript.Echo "strSQL = " & strSQL
objRS.Open strSQL, objConn, 2
if (objRS.BOF or objRS.EOF) then
strMsg = conScriptName & ": No EAS records to process"
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg
WScript.Quit
end if
strDateTime = Date & " " & Time
numUsers = 0
do while not objRS.EOF
strUSERID = objRS("USERID")
if conDEBUG then Wscript.Echo "--Working on USERID = " & strUSERID
numUsers = numUsers + 1
' Get EAS standard information
strSQL = "SELECT USERID, REF_COUNT, UNCOMPRESSEDSIZESUM, COMPRESSEDSIZESUM " & _
"FROM VIEW_STORAGE_BY_USER_REF2 WHERE USERID = '" & strUSERID & "'"
if conDEBUG then Wscript.Echo "strSQL = " & strSQL
objRS2.Open strSQL, objConn, 2
if (objRS2.BOF or objRS2.EOF) then
strMsg = conScriptName & ": Unable to open VIEW_STORAGE_BY_USER_REF2 for user " & strUSERID
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg
WScript.Quit '******????
end if
numREF_COUNT = cDbl(objRS2("REF_COUNT")) ' EAS Total email count
numUNCOMPRESSEDSIZESUM = cDbl(objRS2("UNCOMPRESSEDSIZESUM")) ' EAS MB size un-compressed
numCOMPRESSEDSIZESUM = cDbl(objRS2("COMPRESSEDSIZESUM")) ' EAS MB size compressed
objRS2.Close
' ============================================================
' Build header
' ============================================================
numQuota = clng(objRS("QuotaSize"))
'numMsgSize = clng(objRS("MsgSize")) Use numUNCOMPRESSEDSIZESUM
if numQuota = -1 then
strQuotaDesc = " (Unlimited)"
strPctUsed = " "
else
strQuotaDesc = " "
numPctUsed = (numUNCOMPRESSEDSIZESUM/numQuota)
strPctUsed = FormatPercent(numPctUsed,0,false,false,true)
end if
' Create header
strName = objRS("UserName")
strEmail = objRS("Email")
strSize = pad(FormatNumber(numUNCOMPRESSEDSIZESUM,0,false,false,true),"r",10)
strLimit = pad(FormatNumber(numQuota,0,false,false,true),"r",10)
strCount = pad(FormatNumber(numREF_COUNT,0,false,false,true),"r",10)
strSendSize = pad(FormatNumber(numSendSize,0,false,false,true),"r",4)
strReceiveSize = pad(FormatNumber(numReceiveSize,0,false,false,true),"r",4)
strHTML = strHTMLCSS ' Initialize
strHTML = strHTML ... author note: code with html construction available on request.
' ============================================================
' Build detail lines
' ============================================================
strSQL = "SELECT " & conMaxEmailDetail & _
"SUBJECT, FROMFLD, MSGDATE, MsgSize, FOLDERNAME FROM VWEASUserTopMsgs WHERE USERID = " & strUSERID & _
" ORDER BY MsgSize DESC"
if conDEBUG then Wscript.Echo "strSQL = " & strSQL
objRS3.Open strSQL, objConn, 2
strHTML = strHTML & ... author note: code with html construction available on request.
numCount = 0
do while not objRS3.EOF
numCount = numCount + 1
strMailDate = pad(datevalue(objRS3("MSGDATE")), "r", 10)
strMailSize = pad(CStr(objRS3("MsgSize")),"r", 5) & " MB"
strMailFrom = pad(objRS3("FROMFLD"), "l", 26)
strMailSubject = pad(objRS3("SUBJECT"), "l",31)
strMailFolder = pad(objRS3("FOLDERNAME"), "l",70)
strHTML = strHTML ... author note: code with html construction available on request.
objRS3.movenext
Loop ' All users
strHTML = strHTML & ... author note: code with html construction available on request.
objRS3.Close
' Disclaimer stuff
strHTML = strHTML & ... author note: code with html construction available on request.
' *** END
' ============================================================
' Create email
' ============================================================
if numCount > 0 then
strTo = strEmail
if conDEBUG then strBCC = conEmailAdminUser
strCC = ""
strFrom = conFromUser
strSubject = "Email Account Summary" & conMaxEmailDetail & "" & RTRIM(objRS("UserName"))
else ' You had summary record with no supporting detail
strTo = conEmailAdminUser
strBCC = ""
strCC = ""
strFrom = conFromUser
strSubject = "Failure to Email User:" & RTRIM(objRS("UserName")) & ", No supporting detal"
end if
if conDEBUG then Wscript.Echo strHTML
' Set the message properties.
if conSendMail then
With iMsg
Set .Configuration = iConf
.To = strTo
if len(strBCC) > 0 then .BCC = strBCC
if len(strCC) then .CC = strCC
.From = strFrom
.Subject = strSubject
.HTMLBody = strHTML
End With
iMsg.Send ' send the message.
if err.number = 438 then
if conDEBUG then Wscript.Echo "Skipping error 438 " & err.Description
elseif err.number <> 0 then
intLoc = 5
strMsg = conScriptName & ": Error @ " & intLoc & ". err = " & err.number & " smtp mail send failed for USERID=" & strUSERID
DoError(strMsg)
else ' at some point write to db log
strMsg = conScriptName & ": Mailed: " & strName & " @ " & strSubject & _
"; Size: " & strSize & "; Limit: " & strLimit & "; Count: " & strCount
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg
end if ' ierr
end if ' conSendMail
objRS.movenext
Loop ' All users
strMsg = conScriptName & ": end execution. Total emails sent = " & numUsers
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg
' ============================================================
' The End
' ============================================================
strMsg = "END: " & conScriptName
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg
objRS.Close
objConn.Close
Set objFile = nothing
Set objFile = nothing
' ======================================================
Function DoError(strErrMsg)
On Error Resume Next
Dim objShell
if conDEBUG then wscript.Echo strErrMsg
Set objShell=CreateObject("wscript.shell")
objShell.LogEvent 1,strErrMsg
End Function
' ======================================================
Function pad(strString, strWay, numLen)
' Padd out a passed string
' strWay "r" right, "l" left pad
' numLen overall size you want
Dim numLenVar, numDelta
numLenVar = LEN(strString)
if numLenVar > numLen then
pad = LEFT(strString,numLen)
Exit Function
elseif numLenVar = numLen then
pad = strString
Exit Function
end if
numDelta = numLen - numLenVar
if strWay = "l" then
pad = strString & String(numDelta, " ")
else ' "r"
pad = string(numDelta," ") & strString
end if
End Function
No comments:
Post a Comment