?
Solved

modify script to set exchange mailbox size limits

Posted on 2007-09-28
4
Medium Priority
?
1,172 Views
Last Modified: 2010-05-18
I found this script and it finds all users that do not use our mailbox store defaults and it works great.  I need it to also accept input (from txt file each user on one line) and change the limits on these users to a specified amount (for now it will need to be 4GB - I know, but this is temporary as they clean out the mailbox I will be reducing this amount by rerunning this script).  I know how to do the text file operations, so you don't have to say much about that, but I do not know how to set the values.  I am not sure I was even using the right criteria for the if statement. FoundObject.cn I thought that was the user name, but it didn't seem to be working.
TIA!
0
Comment
Question by:SupportECI
  • 2
4 Comments
 
LVL 1

Author Comment

by:SupportECI
ID: 19979098
Option Explicit

Const ADS_PROPERTY_CLEAR = 1
Const ADS_PROPERTY_UPDATE = 2
Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_DELETE = 4

DIM rootDSE   '*** In a Generic Implementation, the RootDSE finds the current domain
DIM DomainContainer  '*** Used to define the domain we attach to
DIM conn   '*** connection object to attach to Active Directory
DIM ldapStr   '*** specify the LDAP Query String
DIM rs    '*** recordset object for looping through results
DIM users   '*** Specifies a counter for users processed
DIM FoundObject   '*** Variable used when iterating the recordset
DIM Args   '*** Variable to Hold Arguments
DIM CFlag   '*** Change Flag (Argument 1)
DIM ClearedFlag   '*** Yes/No used to display Output to administrator
DIM usrname  '*** used to get user name to change single user

usrname = inputbox("User Name:", "Change User values")

'*** Get the default naming context
Set rootDSE = GetObject("LDAP://RootDSE")
DomainContainer = rootDSE.Get("defaultNamingContext")

'*** Set Variable defaults and grab any arguments, if they exist
'/// DomainContainer = "DC=yourDomain,DC=com" '*** Change this if you need to hard-code the domain name
Users = 0

'*** Check for the /C Argument.  That will determine if we reset the accounts to default
Set Args = wScript.Arguments
If Args.Count > 0 Then CFlag = Args(0)

'*** Create a connection to the Active Directory Database
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"

'*** Build a customized LDAP Query String
ldapStr = "<LDAP://" & DomainContainer & ">;(&(objectClass=user)(mDBUseDefaults=FALSE));adspath;subtree"

'*** Execute the LDAP Query
Set rs = conn.Execute(ldapStr)

'*** Loop through the recordset returned
While Not rs.EOF

 Set FoundObject = GetObject (rs.Fields(0).Value)

if FoundObject.distinguishedName = usrname Then
 Users = Users + 1

 '*** Now, modify the settings

  FoundObject.mDBUseDefaults = TRUE
  FoundObject.putEx ADS_PROPERTY_CLEAR, "mDBStorageQuota", 0
  FoundObject.putEx ADS_PROPERTY_CLEAR, "mDBOverQuotaLimit", 0
  FoundObject.putEx ADS_PROPERTY_CLEAR, "mDBOverHardQuotaLimit", 0
  FoundObject.SetInfo
  Wscript.Echo FoundObject.distinguishedName & chr(9) & ": Reset to Use Defaults"

 Else
  'Wscript.Echo FoundObject.cn & " (Warning/Send/Receive Limits): " & FoundObject.mDBStorageQuota & ", " & FoundObject.mDBOverQuotaLimit & ", " & FoundObject.mDBOverHardQuotaLimit

 End If

      rs.MoveNext

Wend

'*** Output total number of users processed
WScript.Echo "Total User Matches Found: " & Users
0
 
LVL 51

Expert Comment

by:ahoffmann
ID: 19983350
if a 0 value for LDAP's mDBStorageQuota attribute is the correct value to indicate unlimited quota, your code should be fine
So the question remains what you exactly mean by
  >it didn't seem to be working
0
 
LVL 12

Accepted Solution

by:
chandru_sol earned 2000 total points
ID: 19987663
Hi,

You can try the below script to set the mailbox attributes in AD

You need to have an excel sheet with the details below
Distinguished name     Mailbox
This script will also help you in updating bulk changes for attributes.

You have to store the file in this locations -- C:\ADS_Update\UserList.xls



Option Explicit

Const ADS_PROPERTY_CLEAR = 1

Dim strExcelPath, objExcel, objSheet, intRow, strUserDN, strdescription, strphysicalDeliveryOfficeName, strtelephoneNumber
Dim strl, strst, strc, strdepartment, strcompany, strprofilepath
Dim objUser

' Check for required arguments.
If Wscript.Arguments.Count < 1 Then
  Wscript.Echo "Argument <SpreadsheetName> required. For example:" _
    & vbCrLf _
    & "cscript UpdateUserattributes.vbs C:\ADS_Update\UserList.xls"
  Wscript.Quit(0)
End If

' Spreadsheet file.
strExcelPath = Wscript.Arguments(0)

' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Excel application not found."
  Wscript.Quit
End If
On Error GoTo 0

' Open spreadsheet.
On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Spreadsheet cannot be opened: " & strExcelPath
  Wscript.Quit
End If
On Error GoTo 0

' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' The first row of the spreadsheet is skipped (column headings). Each
' row after the first is processed until the first blank entry in the
' first column is encountered. The first column is the Distinguished
' Name of the user, the second column is the new profilePath. The loop
' binds to each user object and assigns the new value for the attribute.
' intRow is the row number of the spreadsheet.
intRow = 2
Do While objSheet.Cells(intRow, 1).Value <> ""
  strUserDN = Trim(objSheet.Cells(intRow, 1).Value)
  strmDBStorageQuota = Trim(objSheet.Cells(intRow, 2).Value)
  If strmDBStorageQuota <> "" Then
    On Error Resume Next
    Set objUser = GetObject("LDAP://" & strUserDN)
    If Err.Number <> 0 Then
      On Error GoTo 0
      Wscript.Echo "User NOT found " & strUserDN
    Else
      On Error GoTo 0
      If LCase(strtelephonenumber) = ".delete" Then
      On Error Resume Next
        objUser.PutEx ADS_PROPERTY_CLEAR, "mDBStorageQuota", 0
        objUser.SetInfo
        If Err.Number <> 0 Then
          On Error GoTo 0
          Wscript.Echo "Unable to clear attributes for user" & " " & strUserDN
        End If
        On Error GoTo 0
      Else
        objUser.mDBStorageQuota = strmDBStorageQuota
      On Error Resume Next
        objUser.SetInfo
        If Err.Number <> 0 Then
          On Error GoTo 0
          Wscript.Echo "Unable to set attributes for user" & " " & strUserDN
        End If
        On Error GoTo 0
      End If
    End If
  End If
  intRow = intRow + 1
Loop

' Close the workbook.
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit

' Clean up.
Set objUser = Nothing
Set objExcel = Nothing
Set objSheet = Nothing

Wscript.Echo "Done"

regards
Chandru
0
 
LVL 1

Author Comment

by:SupportECI
ID: 20010061
Well I was able to find a solution after much googling and copy-pasting.  It is convoluted and probably isn't the best performing, but it works.  You have to run five scripts and I'll give you a little about what they do.
sizes.vbs - creates sizes.txt that lists mailboxdisplayname and the size of the mailbox
limits.vbs - creates limits.txt and nolimits.txt (or you could think of it as notdefault and default, respectively) this creates the text files with distinguised name in the proper file
combine.vbs - creates combinelimits.txt and combinenolimits.txt, it searches the limits text files for the mailboxdisplayname in sizes and addes the user to the new text files with distinguuished name and mailbox size
changelimits - sets the users limits to a secified amount unless they are already over that amount and then it adds some space and sets limits so the mailbox won't get any bigger.
changenolimits - disables using default mail store and sets limits to specified amount unless they are already over that amount, then does same as above

So that is how to get users mailboxsize, disable using store defaults and set the limits to a specified amount or just over what they currently have.
******************************************sizes.vbs******************************************************
On Error Resume Next
Dim cComputerName
Const cWMINameSpace = "root/MicrosoftExchangeV2"

Const cWMIInstance = "Exchange_Mailbox"
cComputerName = "PUTYOUREXCHANGESERVERHERE!!!" ' Modify this value to suit your server

Dim strWinMgmts            ' Connection string for WMI
Dim objWMIExchange   ' Exchange Namespace WMI object
Dim listExchange_Mailboxs  ' ExchangeLogons collection
Dim objExchange_Mailbox           ' A single ExchangeLogon WMI object
Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objTextFile = objFSO.OpenTextFile ("c:\ADS_Update\sizes.txt", 2, true)
' Create the object string, indicating WMI (winmgmts), using the
' current user credentials (impersonationLevel=impersonate),
' on the computer specified in the constant cComputerName, and
' using the CIM namespace for the Exchange provider.
strWinMgmts = "winmgmts:{impersonationLevel=impersonate}!//"& _
cComputerName&"/"&cWMINameSpace
Set objWMIExchange =  GetObject(strWinMgmts)
' Verify we were able to correctly set the object.
If Err.Number <> 0 Then
  WScript.Echo "ERROR: Unable to connect to the WMI namespace."
Else
  ' The Resources that currently exist appear as a list of
  ' Exchange_Mailbox instances in the Exchange namespace.
  Set listExchange_Mailboxs = objWMIExchange.InstancesOf(cWMIInstance)
  ' Were any Exchange_Mailbox Instances returned?
  If (listExchange_Mailboxs.count > 0) Then
    ' If yes, do the following:
    ' Iterate through the list of Exchange_Mailbox objects.
    For Each objExchange_Mailbox in listExchange_Mailboxs
       ' Display the value of the Size property.
        towrite = objExchange_Mailbox.MailboxDisplayName & "," & objExchange_Mailbox.Size
      objTextFile.writeline towrite
    Next
  Else
    ' If no Exchange_Mailbox instances were returned,
    ' display that.
    WScript.Echo "WARNING: No Exchange_Mailbox instances were returned."
  End If
End If
objTextFile.close
*******************************************************************************************************
**********************************limits.txt***********************************************************
Const ADS_PROPERTY_CLEAR = 1
Const ADS_PROPERTY_UPDATE = 2
Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_DELETE = 4
DIM rootDSE   '*** In a Generic Implementation, the RootDSE finds the current domain
DIM DomainContainer  '*** Used to define the domain we attach to
DIM conn   '*** connection object to attach to Active Directory
DIM ldapStr   '*** specify the LDAP Query String
DIM rs    '*** recordset object for looping through results
DIM users   '*** users WITHOUT limits
DIM FoundObject   '*** Variable used when iterating the recordset
DIM Args   '*** Variable to Hold Arguments
DIM CFlag   '*** Change Flag (Argument 1)
DIM ClearedFlag   '*** Yes/No used to display Output to administrator
DIM users2  '*** users with limits
      'ForAppending = 8   ForReading = 1,   ForWriting = 2
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objTextFile = objFSO.OpenTextFile ("c:\ADS_Update\nolimits.txt", 2, true)
      set objTextFile2 = objFSO.OpenTextFile ("C:\ADS_Update\limits.txt", 2, true)
'*** Get the default naming context
Set rootDSE = GetObject("LDAP://RootDSE")
DomainContainer = rootDSE.Get("defaultNamingContext")
'*** Set Variable defaults and grab any arguments, if they exist
'/// DomainContainer = "DC=yourDomain,DC=com" '*** Change this if you need to hard-code the domain name
Users = 0
users2 = 0
'*** Create a connection to the Active Directory Database
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
'*** Build a customized LDAP Query String
ldapStr = "<LDAP://" & DomainContainer & ">;(&(objectClass=user)(mDBUseDefaults=TRUE));adspath;subtree"
'*** Execute the LDAP Query
Set rs = conn.Execute(ldapStr)
'*** Loop through the recordset returned
While Not rs.EOF
 Set FoundObject = GetObject (rs.Fields(0).Value)
       Users = Users + 1
      objTextFile.writeline FoundObject.distinguishedName
        'Wscript.Echo FoundObject.mDBUseDefaults & " (Warning/Send/Receive Limits): " & FoundObject.mDBStorageQuota & ", " & FoundObject.mDBOverQuotaLimit & ", " & FoundObject.mDBOverHardQuotaLimit
      rs.MoveNext
Wend
'******************************************************************************************************************
'*** Build a customized LDAP Query String
ldapStr = "<LDAP://" & DomainContainer & ">;(&(objectClass=user)(mDBUseDefaults=FALSE));adspath;subtree"
'*** Execute the LDAP Query
Set rs = conn.Execute(ldapStr)
'*** Loop through the recordset returned
While Not rs.EOF
 Set FoundObject = GetObject (rs.Fields(0).Value)
      objTextFile2.writeline FoundObject.distinguishedName
      users2 = users2 + 1
      'Wscript.Echo FoundObject.mDBUseDefaults & " (Warning/Send/Receive Limits): " & FoundObject.mDBStorageQuota & ", " & FoundObject.mDBOverQuotaLimit & ", " & FoundObject.mDBOverHardQuotaLimit
      rs.MoveNext
Wend

'*** Output total number of users processed
WScript.Echo "nolimits: " & Users & " - limits:" & users2

objTextFile.Close
objTextFile2.Close
********************************************************************************************************
***************************************combine.vbs*************************************************
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objsizes = objFSO.OpenTextFile ("sizes.txt", 1)
Set objlimits = objFSO.OpenTextFile ("limits.txt", 1)
Set objnolimits = objFSO.OpenTextFile ("nolimits.txt", 1)
Set objcombinelimits = objFSO.OpenTextFile ("combinelimits.txt", 2, true)
Set objcombinenolimits = objFSO.OpenTextFile ("combinenolimits.txt", 2, true)
'Set objdebug = objFSO.OpenTextFile ("debug.txt", 2, true)
Set objerrors      = objFSO.OpenTextFile ("errors.txt", 2, true)
' ForAppending = 8   ForReading = 1,   ForWriting = 2
'*** start by looping through sizes that contains all mailboxes
Do Until objsizes.AtEndOfStream
Set objlimits = objFSO.OpenTextFile ("limits.txt", 1)
Set objnolimits = objFSO.OpenTextFile ("nolimits.txt", 1)
Line = objsizes.ReadLine
'objdebug.WriteLine "NEW LINE " & Line
'*** split mailbox name and size and assign to vars
arrtemp = Split (Line, ",")
name = arrtemp(0)
size = arrtemp(1)
'wscript.echo name & " " & size
found = 0
'objdebug.WriteLine name & " " & size & " " & found
'*** loop through limits.txt and look for the mailbox name
'*** if it is there, we write to combinelimits.txt and exit
Do Until objlimits.AtEndOfStream
searchstring = objlimits.ReadLine
found = InStr(1 ,searchstring,name, 1)
'objdebug.WriteLine searchstring & " " & found
if found <> 0 then
objcombinelimits.WriteLine searchstring & "^" & size
'objdebug.WriteLine "FOUND LIMITS"
Exit Do
end if
Loop
'*** check to see if user was already found
'*** if not look in nolimits.txt and write to combinenolimits.txt
if found = 0 then
'objdebug.WriteLine "LOOKING NOLIMITS"
Do Until objnolimits.AtEndOfStream
searchstring = objnolimits.ReadLine
found = InStr(1 ,searchstring,name, 1)
'objdebug.WriteLine searchstring & " " & found
if found <> 0 then
objcombinenolimits.WriteLine searchstring & "^" & size
'objdebug.WriteLine "FOUND NO LIMITS!!!"
Exit Do
end if
Loop
end if
if found = 0 then
objerrors.WriteLine name & " " & size
'objdebug.WriteLine name & " " & size & " " & found & " " & searchstring & " " & Line & " " & "ERRORRRRR"
end if
objlimits.close
objnolimits.close
Loop
objsizes.close
objcombinelimits.close
objcombinenolimits.close
objerrors.close
*******************************************************************************************************
**************************************changelimits.vbs********************************************
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objcombinelimits = objFSO.OpenTextFile ("combinelimits.txt", 1)
Do Until objcombinelimits.AtEndOfStream
Line = objcombinelimits.ReadLine
arrtemp = Split (Line, "^")
name = arrtemp(0)
size = arrtemp(1)
'wscript.echo name & size
if size < 200000 then
size = 200000
end if

Call setlimits(name, size)

Loop

objcombinelimits.close


Sub setlimits(dn, size)
dim store, over, hard
store = size + 10000
over = size + 20000
hard = size + 30000
Set objPerson = CreateObject("CDO.Person")
objPerson.DataSource.Open "LDAP://" & dn,,3
Set objMailbox = objPerson.GetInterface("IMailboxStore")
If objMailbox.HomeMDB = "" Then
       'MsgBox "No Mailbox found."
Else
       objMailbox.StoreQuota = store
       objMailbox.OverQuotaLimit = over
       objMailbox.HardLimit = hard
       objPerson.DataSource.Save
       'wscript.echo "Mailbox limits for " & recipname & " set successfully"
End If
End Sub
**********************************************************************************************************
********************************changenolimits.vbs************************************************
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objcombinenolimits = objFSO.OpenTextFile ("combinenolimits.txt", 1)
Do Until objcombinenolimits.AtEndOfStream
Line = objcombinenolimits.ReadLine
arrtemp = Split (Line, "^")
name = arrtemp(0)
size = arrtemp(1)
'wscript.echo name & size
if size < 200000 then
size = 200000
end if
Call setlimits(name, size)
Loop
objcombinenolimits.close
Sub setlimits(dn, size)
dim store, over, hard
store = size + 200000
over = size + 40000
hard = size + 60000
Set objPerson = CreateObject("CDO.Person")
objPerson.DataSource.Open "LDAP://" & dn,,3
Set objMailbox = objPerson.GetInterface("IMailboxStore")
If objMailbox.HomeMDB = "" Then
       'MsgBox "No Mailbox found."
Else
       objMailbox.EnableStoreDefaults = False
       objMailbox.StoreQuota = store
       objMailbox.OverQuotaLimit = over
       objMailbox.HardLimit = hard
       objPerson.DataSource.Save
       'wscript.echo "Mailbox limits for " & recipname & " set successfully"
End If
End Sub
*******************************************************************************************************

Could use some cleanup, but I don't get points for this... more for the next sorry sap that has a problem similar to this.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This month, Experts Exchange sat down with resident SQL expert, Jim Horn, for an in-depth look into the makings of a successful career in SQL.
Steps to fix “Unable to mount database. (hr=0x80004005, ec=1108)”.
how to add IIS SMTP to handle application/Scanner relays into office 365.
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
Suggested Courses
Course of the Month15 days, 3 hours left to enroll

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question