EASUsageAudit.vbs: User weekly mailbox recap

Author: Robert Lawson
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

VWEASUserQuotaUsage.SQL: EAS usage view

Author: Robert Lawson
Environment: Windows Server, Microsoft SQL Server, EAS
Description: This view simplifies access to EAS sytem tables and provides key to inhouse Onecard system and match to Active Directory sAMAccount name. Used in conjunction with vbscripts to report over-quota and weekly usage. See EASUsageAudit.vbs and EASNearQuotaEmail.vbs .
Code:

/*
File   : VWEASUserQuotaUsage.SQL
Update : 08-July-2006/Robert Lawson
Purpose: Usage and quota for EAS users (only users with usage)
Notes  :
  - Size and Quota are expressed in MB, Quota = -1, is unlimited
  - Works with VWEASUserTopMsgs

SELECT * FROM VWEASUserQuotaUsage
*/
if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[VWEASUserQuotaUsage]') and OBJECTPROPERTY(id, N'IsView') = 1)
drop view [dbo].[VWEASUserQuotaUsage]

CREATE VIEW dbo.VWEASUserQuotaUsage AS
SELECT
US.USERID,
RTRIM(US.USERNAME) AS UserName,
US.EASQUOTAOPTION,
QuotaSize = CASE WHEN
  US.EASQUOTAOPTION = 1 THEN GP.EASQUOTA
  ELSE US.EASQUOTA
END,
GP.GROUPNAME,
QuotaType = CASE WHEN
  US.EASQUOTAOPTION = 1 THEN 'Group'
  ELSE 'User'
END,
RTRIM(RIGHT(NT.NTACCOUNT,(LEN(NT.NTACCOUNT) - CHARINDEX('\',NT.NTACCOUNT)))) AS sAMAccountName,
RTRIM(RIGHT(NT.NTACCOUNT,(LEN(NT.NTACCOUNT) - CHARINDEX('\',NT.NTACCOUNT)))) + '@uni.edu' AS Email,
COUNT(*) AS MsgCount,
SUM(CAST(PR.MSGSIZE AS BIGINT))/1048576 AS MsgSize
FROM  PROFILE PR, REFER RF, GROUPS GP, NTACCOUNT NT, USERS US
WHERE
US.EASSTATUS = 0 AND
(US.GROUPID > 0 AND US.GROUPID <> 2) AND
NT.USERID = US.USERID AND
GP.GROUPID = US.GROUPID AND
RF.USERID = US.USERID AND
RF.FOLDERID > 0 AND
RF.FOLDERID = (SELECT MAX(R2.FOLDERID) FROM REFER R2 WHERE
                R2.USERID = RF.USERID AND R2.MSGID = RF.MSGID AND R2.FOLDERID > 0) AND
PR.MSGID = RF.MSGID
GROUP BY US.USERID, US.USERNAME, US.EASQUOTAOPTION, GP.EASQUOTA, US.EASQUOTA, NT.NTACCOUNT, GP.GROUPNAME

VWEASUserTopMsgs.sql: EAS top user attachments

Author: Robert Lawson
Environment: Windows Server, Microsoft SQL Server, EAS
Description: This view simplifies access to EAS sytem tables and list of largest email attachments. Used in conjunction with vbscripts to report over-quota and weekly usage. See EASUsageAudit.vbs .
Code:

/*
File   : VWEASUserTopMsgs.sql
Update : 08-July-2006/Robert Lawson
Purpose: Get biggest emails for a given user
Notes  :
  - Size is in MB to be consistent with Quota and VWEASUserQuotaUsage
  - Works with VWEASUserQuotaUsage (gets the user information)

SELECT TOP 20 * FROM VWEASUserTopMsgs WHERE USERID = 9 ORDER BY MsgSize DESC
*/
if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[VWEASUserTopMsgs]') and OBJECTPROPERTY(id, N'IsView') = 1)
drop view [dbo].[VWEASUserTopMsgs]

CREATE VIEW dbo.VWEASUserTopMsgs AS
SELECT
RF.MSGID,
RF.USERID,
FL.FOLDERNAME,
PR.SUBJECT,
PR.FROMFLD,
PR.MSGDATE,
PR.MSGSIZE/1048576 MsgSize
FROM FOLDER FL, PROFILE PR, REFER RF
WHERE
RF.FOLDERID > 0 AND
RF.FOLDERID = (SELECT MAX(R2.FOLDERID) FROM REFER R2 WHERE
                R2.USERID = RF.USERID AND R2.MSGID = RF.MSGID AND R2.FOLDERID > 0) AND
PR.MSGID = RF.MSGID AND
FL.USERID = RF.USERID AND
FL.FOLDERID = RF.FOLDERID 

UserOutlookEAS.vbs: Install EAS Outlook client

Author: Robert Lawson
Environment: Windows XP, Outlook , EAS, vb-script
Description: This installs the EAS client for Outlook users in a given Active Directory OU, if they are a member of an EAS group. This script is run as Active Directory Group Policy log on script, and to make trouble shooting easier, all steps are written to application event log.
Code:

'=========================================================================
' VBScript Source File -- Created with XLnow OnScript
' FILE   : UserOutlookEAS.vbs
' AUTHOR : Robert Lawson
' COMPANY: Soka University of America
' DATE   :  6/19/2006  Robert Lawson Creation Date
'          11/20/2006  Robert Lawson Always do Outlook updates, improved on EAS logic
'          12/01/2006  Robert Lawson Added disable menu and remove pst references
' COMMENT: Manage EAS deployment: installing EAS client, and making Outlook setting
' conUpdateRegKeys controls if this will update registry keys (Outlook settings)
' Office 2003 only (Office Versions: 11.0 = 2003; 10.0 = XP)
' Registry keys are not setup by default by Outlook

'=========================================================================
option explicit
On Error Resume Next ' Required for reading registry
const conScriptName = "UserOutlookEAS.vbs"
const conDEBUG = FALSE
const conUpdateRegKeys = TRUE ' TRUE = will update Outlook reg keys

Dim strMsg, intLoc
Dim objShell, varTemp, bolRegKeyExists, varNewValue
Dim objFSO, objTS, objExecute
Dim bolOutlookInstalled, bolZantazClientInstalled, bolEASUser
Dim objNetwork, strUserName, strUserDomain, strGroupName, strComputerName
Dim strOU, strFilter, strQuery, rs, objCommand, UserADsPath, objUser, objConnection, objGroup, strKey

const conOutlookRegistryKey = "HKCU\Software\Microsoft\Office\11.0\Outlook\OutlookName"
const conOutlookDisableAutoArchiveKey = "HKCU\Software\Microsoft\Office\11.0\Outlook\Preferences\DoAging"
const conOutlookDisableCreatePSTfilesKey = "HKLM\SOFTWARE\Microsoft\Office\11.0\Outlook\DisablePST"
const conOutlookDisabledCmdBarKey = "HKEY_CURRENT_USER\Software\Policies\Microsoft\Office\11.0\Outlook\DisabledCmdBarItemsList"
const conZantazFile = "C:\Program Files\ZANTAZ\EAS Client\EASCOMPRESS.dll"
const conEASclient = "\\server3\Client\uniClient.msi"
const conRegKeyYes = 1
const conEASGroup = "EASUser"

' Window stype to run
const WINDOWHIDDEN = 0
const WINDOWNORMAL = 1
const WINDOWMINIMIZE = 2
Const ADS_SCOPE_SUBTREE = 2

' ============================================================
' Setup
' ============================================================
Set objShell = CreateObject( "WScript.Shell" )
Set objNetwork = Wscript.CreateObject("Wscript.Network")

set objConnection=Createobject("ADODB.Connection")
set objCommand=CreateObject("ADODB.Command")
objConnection.Provider="ADSDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

strMsg = "BEGIN: " & conScriptName
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg

' ============================================================
' Determine if EAS User (determined by AD group membership)?
' ============================================================
' Get User Info from Network log in
strComputerName = objNetwork.ComputerName
strUserName = objNetwork.UserName
strUserDomain = objNetwork.UserDomain
strMsg = conScriptName & " values: CN = " & strComputerName & "; UN = " & strUserName & "; DN = " & strUserDomain
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg

' Get User Active Directory information
bolEASUser = FALSE
strOU = "DC=uni,DC=edu"
strFilter = "sAMAccountName = " & "'" & strUserName & "'"
strQuery = "SELECT ADsPath FROM 'LDAP://" & strOU & "' WHERE " & strFilter

strMsg = conScriptName & ": LDAP strQuery = " & strQuery
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg

objCommand.CommandText= strQuery
objCommand.Properties("Searchscope") =    ADS_SCOPE_SUBTREE
Set rs = objCommand.Execute
if rs.EOF or rs.BOF then
 intLoc = 5
 strMsg = conScriptName & ": Error @ " & intLoc & ".  Unabled to get AD user for " & strUserName
 if conDEBUG then Wscript.Echo strMsg
 objShell.LogEvent 0,strMsg
else
 ' Verify if user is member of an EAS group
 UserADsPath = rs.fields("ADsPath").value
 Set objUser = GetObject(UserADsPath)

 For Each objGroup In objUser.Groups
  ' sample: "CN=grpPeopleSoftDBTech"
  strGroupName = objGroup.Name
  if conDEBUG then Wscript.Echo strGroupName
  bolEASUser = (instr(1,strGroupName,conEASGroup) > 0)
  if bolEASUser then Exit For
 Next
end if
strMsg = conScriptName & ": bolEASUser = " & bolEASUser
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg

' ============================================================
' Is Outlook installed for this computer user?
' ============================================================
varTemp = objShell.RegRead (conOutlookRegistryKey)
bolOutlookInstalled = (Err.number= 0)
if conDEBUG then Wscript.Echo " bolOutlookInstalled= " &  bolOutlookInstalled

' ============================================================
' Is Zantaz EAS client installed on this computer?  If not, do so
' ============================================================
set objFSO = CreateObject("Scripting.FileSystemObject")
bolZantazClientInstalled = (objFSO.FileExists(conZantazFile))
strMsg = conScriptName & ": bolOutlookInstalled = " & bolOutlookInstalled & "; conUpdateRegKeys = " & conUpdateRegKeys & _
  "; bolZantazClientInstalled = " & bolZantazClientInstalled
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg

' Need to install EAS client?
if bolOutlookInstalled and Not bolZantazClientInstalled then
 set objFSO = CreateObject("Scripting.FileSystemObject")
 if (objFSO.FileExists(conEASclient)) then
  objShell.Run conEASclient, WINDOWHIDDEN, True
  if err.number = 0 then
   strMsg = conScriptName & ": Installed successfully " & conEASclient
   if conDEBUG then Wscript.Echo strMsg
   objShell.LogEvent 0,strMsg
   bolZantazClientInstalled = TRUE
     else
   intLoc = 10
   strMsg = conScriptName & ": Error @ " & intLoc & " Num = " & Err.number & " " & Err.Description
   DoError(strMsg) ' Failed to execute
  end if
 else
  intLoc = 15
  strMsg = conScriptName & ": Error @ " & intLoc & ".  File does not exist " & conEASclient
  DoError(strMsg) ' File does not exist
 end if
end if

' ============================================================
' Update Outlook Registry Entries?
' ============================================================
if bolOutlookInstalled and conUpdateRegKeys then
 ' Disable auto archive features? 1=yes, 0=no (if no registry, treated as = 0)
 varTemp = ""
 varTemp = obJShell.RegRead(conOutlookDisableAutoArchiveKey)
 bolRegKeyExists = (err.number = 0)
 err.Clear
 if Not bolRegKeyExists or (varTemp <> conRegKeyYes) then
  objShell.RegWrite conOutlookDisableAutoArchiveKey, conRegKeyYes, "REG_DWORD"
  if err.number = 0 then
   strMsg = conScriptName & ": Updated registry " & conOutlookDisableAutoArchiveKey
   if conDEBUG then Wscript.Echo strMsg
   objShell.LogEvent 0,strMsg
     else
   intLoc = 20
   strMsg = conScriptName & ": Error @ " & intLoc & " Num = " & Err.number & " " & Err.Description
   DoError(strMsg) ' Failed to execute
  end if
 else
  strMsg = conScriptName & ": Registry not updated, value already set for  " & conOutlookDisableAutoArchiveKey
  if conDEBUG then Wscript.Echo strMsg
  objShell.LogEvent 0,strMsg
 end if

 ' Disable creating any pst files? 1=yes, 0=no (if no registry, treated as = 0)
 varTemp = ""
 varTemp = obJShell.RegRead(conOutlookDisableCreatePSTfilesKey)
 bolRegKeyExists = (err.number = 0)
 err.Clear
 if Not bolRegKeyExists or (varTemp <> conRegKeyYes)  then
  objShell.RegWrite conOutlookDisableCreatePSTfilesKey, conRegKeyYes, "REG_DWORD"
  if err.number = 0 then
   strMsg = conScriptName & ": Updated registry " & conOutlookDisableCreatePSTfilesKey
   if conDEBUG then Wscript.Echo strMsg
   objShell.LogEvent 0,strMsg
     else
   intLoc = 23
   strMsg = conScriptName & ": Error @ " & intLoc & " Num = " & Err.number & " " & Err.Description
   DoError(strMsg) ' Failed to execute
  end if
 else
  strMsg = conScriptName & ": Registry not updated, value already set for  " & conOutlookDisableCreatePSTfilesKey
  if conDEBUG then Wscript.Echo strMsg
  objShell.LogEvent 0,strMsg
 end if

 ' Disable Outlook menu items  KB309136
    ' TCID1 5575 Disable option to create a PST (File>New>Outlook Data File)
    ' TCID2 5576 Disable option to open a PST (File>Open>Outlook Data File)
 strKey = conOutlookDisabledCmdBarKey & "\TCID1"  ' Unique value for menu disable
 varNewValue = "5575" ' Disable option to create a PST              
 objShell.RegWrite strKey, varNewValue, "REG_SZ"
 if err.number = 0 or err.number = 500 then
  err.Clear
  strMsg = conScriptName & ": Updated registry " & strKey
  if conDEBUG then Wscript.Echo strMsg
  objShell.LogEvent 0,strMsg
    else
  intLoc = 25
  strMsg = conScriptName & ": Error @ " & intLoc & " Num = " & Err.number & " " & Err.Description
  DoError(strMsg) ' Failed to execute
 end if

 strKey = conOutlookDisabledCmdBarKey & "\TCID2" ' Unique value for menu disable
 varNewValue = "5576"   ' Disable option to open a PST           
 objShell.RegWrite strKey, varNewValue, "REG_SZ"
 if err.number = 0 or err.number = 500 then
  err.Clear
  strMsg = conScriptName & ": Updated registry " & strKey
  if conDEBUG then Wscript.Echo strMsg
  objShell.LogEvent 0,strMsg
    else
  intLoc = 30
  strMsg = conScriptName & ": Error @ " & intLoc & " Num = " & Err.number & " " & Err.Description
  DoError(strMsg) ' Failed to execute
 end if
end if ' Registry Entry update

' ============================================================
' The End
' ============================================================
strMsg = "END: " & conScriptName
if conDEBUG then Wscript.Echo strMsg
objShell.LogEvent 0,strMsg

Set objNetwork = 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

EASNearQuotaEmail.vbs: Email over quota notice

Author: Robert Lawson
Environment: SQL Server, Windows Server, vb-script, EAS, Exchange
Description: This script is run as nightly job to notify users if their email EAS mailbox storage is nearing quota. The assumption is that the EAS storage for email attachments will fill up first and that the users have been getting a weekly report of the usage: EASUsageAudit.vbs
Features:
- Configurable quota to begin sending notification
- Custom wording to send in email
- bcc notification to administrator(s) of email sent
- Write to application event log for easy trouble-shooting
Sample:

Code Listing:

'=========================================================================

' FILE:    EASNearQuotaEmail.vbs

' AUTHOR:  Robert Lawson

' COMPANY: Soka University of America

' DATE:     6/01/2006 Robert Lawson, Creation Date

'          11/12/2006 Added EAS VIEW_STORAGE_BY_USER_REF2, not "as" correct,

'                     but is used for enforcing quota.

' COMMENT: Audit EAS Usage and notification

'  - Set value of "conSendMail" if you send mail or not, also conDEBUG

'  - Relies heavily on t-sql view VWEASUserQuotaUsage

'  - Server run on has to be allow SMTP relay on Exchange

'  - VWEASUserQuotaUsage can not calc percent, must be done in program



'=========================================================================

option explicit

On Error Resume Next

const conScriptName = "EASNearQuotaEmail.vbs"

const conDEBUG = TRUE

const conSendMail = FALSE ' TRUE = will send email, FALSE=will not



Dim objShell, strMsg, intLoc

Dim objConn, objRS, objRS2, strSQL, strConn

Dim numQuotaSize, numMsgSize, numEASPct, numMsgCount

Dim numREF_COUNT, numUNCOMPRESSEDSIZESUM, numCOMPRESSEDSIZESUM

Dim strQuotaSize, strMsgSize, strEASPct, strUserName

Dim strMailBody, numCount, numUsers, strUSERID, strDetail, strQuotaDesc

Dim iMsg, iConf, Flds

Dim strTo, strBCC, strCC, strFrom, strSubject, strTextBody



Const conEASQuotaUnlimited = -1

Const conMaxEASNotificationPct = .95 ' EAS percent to warn at (1=100%)

' 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 = "E-Admini@campus.edu"

Const conEmailAdminUser = "robert.lawson@campus.edu" ' comma seperated



' Setup

Set objShell = CreateObject( "WScript.Shell" )



' Write event log that you started

strMsg = conScriptName & ": Begin execution"

if conDEBUG then Wscript.Echo strMsg

objShell.LogEvent 0,strMsg



' 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



' DB stuff

Set objConn = CreateObject("ADODB.Connection")

Set objRS = CreateObject("ADODB.Recordset")

Set objRS2 = CreateObject("ADODB.Recordset")

strConn = "Provider=SQLOLEDB; SERVER=YourServer; DATABASE=DBname;Integrated Security = SSPI"

objConn.Open strConn



' Get summary for active EAS users with space used

strSQL = "SELECT USERID, UserName, QuotaSize, QuotaType, Email, MsgCount, MsgSize " & _

  "FROM VWEASUserQuotaUsage"

strSQL = strSQL & " WHERE QuotaSize > 0" ' Not unlimited

' strSQL = strSQL & " AND USERID = 497" ' **** 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



numUsers = 0

do while not objRS.EOF

 strUSERID = objRS("USERID")



 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



 strUserName = RTRIM(objRS("UserName"))

 numQuotaSize = cDbl(objRS("QuotaSize"))

 ' numMsgCount = cDbl(objRS("MsgCount")) Use numREF_COUNT

 ' numMsgSize = cDbl(objRS("MsgSize")) Use numUNCOMPRESSEDSIZESUM

 if numQuotaSize <= 0 then    numEASPct = 1.0  else   numEASPct = numUNCOMPRESSEDSIZESUM / numQuotaSize  end if    if numEASPct > conMaxEASNotificationPct then

  numUsers = numUsers + 1

  if conDEBUG then Wscript.Echo "--USERID/Name = " & strUSERID & "/" & strUserName & " pct: " & numEASPct



  if numQuotaSize = conEASQuotaUnlimited then

   strQuotaDesc = " (Unlimited)"

   strEASPct = " "

  else

   strQuotaDesc = " "

   strEASPct =  FormatPercent(numEASPct,0,false,false,true)

  end if

  strMsgSize = FormatNumber(numUNCOMPRESSEDSIZESUM,0,false,false,true)

  strQuotaSize = FormatNumber(numQuotaSize,0,false,false,true)

  strMsgCount =  FormatNumber(numREF_COUNT,0,false,false,true)



  ' Create header FormatNumber(objRS("QuotaSize"),0,false,false,true)

  strMailBody = ""

  strMailBody = _

  "You have received this message because your mailbox is approaching its size limit." & vbCrLF & _

  "Your mailbox size is currently " & strEASPct & " full (size (MB): " & strMsgSize & "; limit (MB): " & strQuotaSize & ").  " & _

  "When your mailbox fills up you will not be able to send nor receive any more email.  " &  _

  "Please do the following to reduce mailbox volume:" & vbCrLF & _

  "1. Delete items in the Sent-Items folder" & vbCrLF & _

  "2. Empty the Deleted-Items folder" & vbCrLF & _

  "3. Sort messages by the attachment icon and delete messages with large attachments" & vbCrLF & _

  "Mailbox space can be freed up most efficiently by focusing on deleting emails with attachments.  In most cases a large portion of a mailbox’s volume is occupied by a collection of emails with attachments like photos, music, videos and scans.  This also includes emails you sent to others and remain in your “Sent Items” folder.  Note the mailbox size and limits refer to the EAS system." & vbCrLF & _

  "Thank you" & vbCrLF & "SUA-Email-Administrators" & vbCrLF & vbCrLF & _

  "source: " & conScriptName & vbCrLF



  ' Prep email

  strTo = objRS("Email")

  strBCC = conEmailAdminUser

  strCC =  ""

  strFrom = conFromUser

  strSubject = "Your Mailbox is Approaching its Size Limit" & strUserName

  strTextBody = strMailBody

  if conDEBUG then Wscript.Echo strMailBody



  ' Send thu sucku

  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

   .TextBody = strTextBody

   End With

   iMsg.Send ' send the message.

   if err.number <> 0 then

    intLoc = 5

    strMsg = conScriptName & ": Error @ " & intLoc & ".  smtp mail send failed for " & strUSERID

    DoError(strMsg)

   else  ' at some point write to db log

    strMsg = conScriptName & ": email sent to " & strTo & ", subject: " & strSubject

    if conDEBUG then Wscript.Echo strMsg

    objShell.LogEvent 0,strMsg

   end if ' ierr

  end if ' conSendMail

 end if ' numEASPct

 objRS.movenext

 objRS2.Close

Loop ' All users



strMsg = conScriptName & ": end execution.  Total emails sent = " & numUsers

if conDEBUG then Wscript.Echo strMsg

objShell.LogEvent 0,strMsg



objRS.Close

objConn.Close



' ======================================================

Function DoError(strErrMsg)

On Error Resume Next

Dim objShell



' wscript.Echo strErrMsg



Set objShell=CreateObject("wscript.shell")

objShell.LogEvent 1,strErrMsg

End Function