This is Interesting: Free IT Magazines  
Home > Archive > Exchange Server Tools > September 2005 > tools or script for mailbox/mailstore information in E2k3





You are viewing an archived Text-only version of the thread. To view this thread in it's original format and/or if you want to reply to this thread please [click here]

Author tools or script for mailbox/mailstore information in E2k3
CJ

2005-06-29, 5:47 pm

does anyone know of any utility or a script that pulls the users mailbox
limit, current mailbox size, storage group and mailstore out of AD and
Exchange 2003?
Thanks a lot
Al Mulnick

2005-06-29, 5:47 pm

Scripts would be pretty easy for that information; you'll just need to put
them together based on the Exchange_Mailbox Class
(http://msdn.microsoft.com/library/d...I
nfo.asp).

http://msdn.microsoft.com/library/d...I
nfo.asp

http://msdn.microsoft.com/library/d...I
nfo.asp

http://msdn.microsoft.com/library/d...I
nfo.asp

http://msdn.microsoft.com/library/d...I
nfo.asp


Al




"CJ" <CJ@discussions.microsoft.com> wrote in message
news:E847FF39-510B-4B5B-A45B-C9D76828653C@microsoft.com...
> does anyone know of any utility or a script that pulls the users mailbox
> limit, current mailbox size, storage group and mailstore out of AD and
> Exchange 2003?
> Thanks a lot


Bernard Chouinard

2005-06-30, 8:46 pm

Here is an hta that will do what you want, you will need to change
arrComputers and strDomain
parameter in it to fit your environment . You will need excel installed. The
result is saved in the temp directory but you can change that.

<html>
<head>
<title>Authentication</title>
<HTA:APPLICATION
ID="objMailboxReport"
APPLICATIONNAME="MailboxReport"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
>
</head>
<style>
BODY{background-color: buttonface; font-family: Helvetica; font-size: 10;}
.button{font-family: arial; font-size: 10pt;}
</style>
<SCRIPT Language="VBScript">
i=0
Sub Window_Onload
self.ResizeTo 210,200
strHTML = strHTML & "<font style=""button"">"
strHTML = strHTML & "<b>Enter your authentication credentials</b><hr>"
strHTML = strHTML & "Domain:&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input
type=""text"" name=""DomainNameBox"" size=""15""><br>User Name: <input
type=""text"" name=""UserNameBox""
size=""15""><br>Password:&nbsp;&nbsp;&nbsp; <input type=""password""
name=""PasswordArea"" size=""15"">"
strHTML = strHTML & "<input id=runbutton class=""button"" type=""button""
value=""Submit"" name=""run_button"" onClick=""RunScript"">"
Authentication.InnerHTML = strHTML
End Sub
Sub RunScript
ConfirmRun = MsgBox ("This process will search through all the Exchange
Servers in order" & VbCrLf _
& "to enumerate mailboxes and their sizes in addition to querying
AD" & VbCrLf _
& "using RootDSE to enumerate mailbox limit attributes. This
process" & VbCrLf _
& "will take a long time to complete and will consume a portion
of local" & VbCrLf _
& "resources during processing. Are you sure you wish to
continue?", _
68, "Run Mailbox Size and Quota Report")
If ConfirmRun = 6 Then
On Error Resume Next
'-- Check to see if Excel is installed.
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
On Error GoTo 0
WScript.Echo "Excel application not found."
WScript.Quit
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
objName = objFSO.GetTempName
objTempFile = objName
Set outfile = objFSO.OpenTextFile(objTempFile, 2, True)
objExcel.Workbooks.Add
'-- Format the spreadsheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Range("A1:C10000").Font.Size = 8
objSheet.Range("A1:C1").Font.Bold = True
objSheet.Name = "MBX Size"
ObjSheet.Columns(1).Columnwidth = 20
ObjSheet.Columns(2).Columnwidth = 14
ObjSheet.Columns(3).Columnwidth = 8
intRow = 2
intCola = 1
intColb = 2
intColc = 3
intCold = 4
intCole = 5
objSheet.Cells(1, 1).Value = "MailboxDisplayName"
objSheet.Cells(1, 2).Value = "ServerName"
objSheet.Cells(1, 3).Value = "Size(KB)"
strExcelPath = "C:\temp\Mailbox_Quota.xls"
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
g=0
'-- Edit this line to change servers queried.
arrComputers = Array("server1","server2")
'-- Edit this line to reflect the domain where the mail server reside.
strDomain = "Domainname"
strCount = UBound(arrComputers)
'-- Query the Exchange servers in the array.
For Each strComputer In arrComputers
strCountA = strCount-1
Set objCompName = GetObject("WinNT://" & strDomain & "/" & strComputer)
Set progBar = CreateObject("internetexplorer.application")
progBar.navigate2 "about :blank" : progBar.width = 350 : progBar.height =
120 : progBar.toolbar = false : progBar.menubar = False : progBar.statusbar
= False : progBar.visible = True
progBar.document.write "<font color=blue>"
progBar.document.write "Querying data from " & objCompName.Name & "<br>
(" & strCountA & " remaining)"
progBar.document.title = "Current Progress..."
Set SWbemLocator = CreateObject("WbemScripting.SWBemlocator")
Set objWMIService = SWBemlocator.ConnectServer _
(strComputer, "root\MicrosoftExchangeV2", _
DomainNameBox.Value & "\" & UserNameBox.Value, PasswordArea.Value)
Set colItems = objWMIService.ExecQuery("SELECT * FROM Exchange_Mailbox",
"WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
outfile.writeline objItem.MailboxDisplayName
objSheet.Cells(intRow, intCola).Value = objItem.MailboxDisplayName
objSheet.Cells(intRow, intColb).Value = objItem.ServerName
objSheet.Cells(intRow, intColc).Value = objItem.Size
intRow = intRow+1
g=g+1
Next
progBar.quit
Next
outfile.close
intRow=2
n1 = g/100
nA = Round(n1, 0)
n = 0
'-- Format the second worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(2)
Set infile = objFSO.OpenTextFile(objTempFile)
Set progBar = CreateObject("internetexplorer.application")
progBar.navigate2 "about :blank" : progBar.width = 350 : progBar.height =
80 : progBar.toolbar = false : progBar.menubar = False : progBar.statusbar =
False : progBar.visible = True
objSheet.Range("A1:E10000").Font.Size = 8
objSheet.Range("A1:E1").Font.Bold = True
objSheet.Name = "MBX Quota"
ObjSheet.Columns(1).Columnwidth = 20
ObjSheet.Columns(2).Columnwidth = 20
ObjSheet.Columns(3).Columnwidth = 17
ObjSheet.Columns(4).Columnwidth = 16
ObjSheet.Columns(5).Columnwidth = 27
objSheet.Range("C2:C10000").HorizontalAlignment = -4108
objSheet.Range("D2:D10000").HorizontalAlignment = -4108
objSheet.Range("E2:E10000").HorizontalAlignment = -4108
objSheet.Cells(1, 1).Value = "Display Name"
objSheet.Cells(1, 2).Value = "Use MBX Store Defaults"
objSheet.Cells(1, 3).Value = "Issue Warning (KB)"
objSheet.Cells(1, 4).Value = "Prohibit Send (KB)"
objSheet.Cells(1, 5).Value = "Prohibit Send and Recieve (KB)"
'-- Query AD for mailbox limit information.
Do While infile.AtEndOfStream <> True
strLine = infile.ReadLine
If n > nA Then
progBar.document.write "<font color=blue>"
progBar.document.write "|"
progBar.document.title = "Enumerating Acct Info..."
n=0
End If
arrdisplayName = Split(strLine, VbCrLf)
strdisplayName = arrdisplayName(0)
Set objRootDSE = GetObject("LDAP://rootDSE")
strADsPath = "LDAP://" & objRootDSE.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = "SELECT
distinguishedName,displayName,mDBStorage
Quota,mDBOverQuotaLimit,mDBOverHardQuota
Limit
FROM 'LDAP://dc=dems,dc=mil,dc=ca' WHERE displayName = '" & strdisplayName &
"'"
objCommand.Properties("Page Size")= 1000
Set objRecordSet = objCommand.Execute
While Not objRecordset.EOF
strADSPathA = objRecordset.Fields("distinguishedName")
Set oUser = GetObject("LDAP://" & strADSPathA)
objSheet.Cells(intRow, intCola).Value = oUser.displayName
objSheet.Cells(intRow, intColb).Value = oUser.mDBUseDefaults
objSheet.Cells(intRow, intColc).Value = oUser.mDBStorageQuota
objSheet.Cells(intRow, intCold).Value = oUser.mDBOverQuotaLimit
objSheet.Cells(intRow, intCole).Value = oUser.mDBOverHardQuotaLimit
intRow = intRow+1
objRecordset.MoveNext
Wend
n=n+1
Loop
progBar.quit
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
infile.Close
objFSO.DeleteFile(objTempFile)
MsgBox "Report is located at C:\temp\Mailbox_quota.xls", "Report
Completed"
'-- Clean up.
Set objRootDSE = Nothing
Set objConnection = Nothing
Set objCommand = Nothing
Set objFSO = Nothing
Else
window.close()
End If
window.close()
End Sub
</SCRIPT>
<body>
<span id="Authentication"></span>
</body>
</html>


"Al Mulnick" <amulnick_No_SPAM@ncDOTrr.com> wrote in message
news:e$647wMfFHA.1248@TK2MSFTNGP12.phx.gbl...
> Scripts would be pretty easy for that information; you'll just need to put
> them together based on the Exchange_Mailbox Class
> (http://msdn.microsoft.com/library/d...I
nfo.asp).
>
> http://msdn.microsoft.com/library/d...I
nfo.asp
>
> http://msdn.microsoft.com/library/d...I
nfo.asp
>
> http://msdn.microsoft.com/library/d...I
nfo.asp
>
> http://msdn.microsoft.com/library/d...I
nfo.asp
>
>
> Al
>
>
>
>
> "CJ" <CJ@discussions.microsoft.com> wrote in message
> news:E847FF39-510B-4B5B-A45B-C9D76828653C@microsoft.com...
>
>



CJ

2005-07-05, 5:47 pm

Thanks a million for both of your help!!!

"Bernard Chouinard" wrote:

> Here is an hta that will do what you want, you will need to change
> arrComputers and strDomain
> parameter in it to fit your environment . You will need excel installed. The
> result is saved in the temp directory but you can change that.
>
> <html>
> <head>
> <title>Authentication</title>
> <HTA:APPLICATION
> ID="objMailboxReport"
> APPLICATIONNAME="MailboxReport"
> SCROLL="no"
> SINGLEINSTANCE="yes"
> WINDOWSTATE="normal"
> </head>
> <style>
> BODY{background-color: buttonface; font-family: Helvetica; font-size: 10;}
> .button{font-family: arial; font-size: 10pt;}
> </style>
> <SCRIPT Language="VBScript">
> i=0
> Sub Window_Onload
> self.ResizeTo 210,200
> strHTML = strHTML & "<font style=""button"">"
> strHTML = strHTML & "<b>Enter your authentication credentials</b><hr>"
> strHTML = strHTML & "Domain: <input
> type=""text"" name=""DomainNameBox"" size=""15""><br>User Name: <input
> type=""text"" name=""UserNameBox""
> size=""15""><br>Password: <input type=""password""
> name=""PasswordArea"" size=""15"">"
> strHTML = strHTML & "<input id=runbutton class=""button"" type=""button""
> value=""Submit"" name=""run_button"" onClick=""RunScript"">"
> Authentication.InnerHTML = strHTML
> End Sub
> Sub RunScript
> ConfirmRun = MsgBox ("This process will search through all the Exchange
> Servers in order" & VbCrLf _
> & "to enumerate mailboxes and their sizes in addition to querying
> AD" & VbCrLf _
> & "using RootDSE to enumerate mailbox limit attributes. This
> process" & VbCrLf _
> & "will take a long time to complete and will consume a portion
> of local" & VbCrLf _
> & "resources during processing. Are you sure you wish to
> continue?", _
> 68, "Run Mailbox Size and Quota Report")
> If ConfirmRun = 6 Then
> On Error Resume Next
> '-- Check to see if Excel is installed.
> Set objExcel = CreateObject("Excel.Application")
> If Err.Number <> 0 Then
> On Error GoTo 0
> WScript.Echo "Excel application not found."
> WScript.Quit
> End If
> Set objFSO = CreateObject("Scripting.FileSystemObject")
> objName = objFSO.GetTempName
> objTempFile = objName
> Set outfile = objFSO.OpenTextFile(objTempFile, 2, True)
> objExcel.Workbooks.Add
> '-- Format the spreadsheet.
> Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
> objSheet.Range("A1:C10000").Font.Size = 8
> objSheet.Range("A1:C1").Font.Bold = True
> objSheet.Name = "MBX Size"
> ObjSheet.Columns(1).Columnwidth = 20
> ObjSheet.Columns(2).Columnwidth = 14
> ObjSheet.Columns(3).Columnwidth = 8
> intRow = 2
> intCola = 1
> intColb = 2
> intColc = 3
> intCold = 4
> intCole = 5
> objSheet.Cells(1, 1).Value = "MailboxDisplayName"
> objSheet.Cells(1, 2).Value = "ServerName"
> objSheet.Cells(1, 3).Value = "Size(KB)"
> strExcelPath = "C:\temp\Mailbox_Quota.xls"
> Const wbemFlagReturnImmediately = &h10
> Const wbemFlagForwardOnly = &h20
> g=0
> '-- Edit this line to change servers queried.
> arrComputers = Array("server1","server2")
> '-- Edit this line to reflect the domain where the mail server reside.
> strDomain = "Domainname"
> strCount = UBound(arrComputers)
> '-- Query the Exchange servers in the array.
> For Each strComputer In arrComputers
> strCountA = strCount-1
> Set objCompName = GetObject("WinNT://" & strDomain & "/" & strComputer)
> Set progBar = CreateObject("internetexplorer.application")
> progBar.navigate2 "about :blank" : progBar.width = 350 : progBar.height =
> 120 : progBar.toolbar = false : progBar.menubar = False : progBar.statusbar
> = False : progBar.visible = True
> progBar.document.write "<font color=blue>"
> progBar.document.write "Querying data from " & objCompName.Name & "<br>
> (" & strCountA & " remaining)"
> progBar.document.title = "Current Progress..."
> Set SWbemLocator = CreateObject("WbemScripting.SWBemlocator")
> Set objWMIService = SWBemlocator.ConnectServer _
> (strComputer, "root\MicrosoftExchangeV2", _
> DomainNameBox.Value & "\" & UserNameBox.Value, PasswordArea.Value)
> Set colItems = objWMIService.ExecQuery("SELECT * FROM Exchange_Mailbox",
> "WQL", _
> wbemFlagReturnImmediately + wbemFlagForwardOnly)
> For Each objItem In colItems
> outfile.writeline objItem.MailboxDisplayName
> objSheet.Cells(intRow, intCola).Value = objItem.MailboxDisplayName
> objSheet.Cells(intRow, intColb).Value = objItem.ServerName
> objSheet.Cells(intRow, intColc).Value = objItem.Size
> intRow = intRow+1
> g=g+1
> Next
> progBar.quit
> Next
> outfile.close
> intRow=2
> n1 = g/100
> nA = Round(n1, 0)
> n = 0
> '-- Format the second worksheet.
> Set objSheet = objExcel.ActiveWorkbook.Worksheets(2)
> Set infile = objFSO.OpenTextFile(objTempFile)
> Set progBar = CreateObject("internetexplorer.application")
> progBar.navigate2 "about :blank" : progBar.width = 350 : progBar.height =
> 80 : progBar.toolbar = false : progBar.menubar = False : progBar.statusbar =
> False : progBar.visible = True
> objSheet.Range("A1:E10000").Font.Size = 8
> objSheet.Range("A1:E1").Font.Bold = True
> objSheet.Name = "MBX Quota"
> ObjSheet.Columns(1).Columnwidth = 20
> ObjSheet.Columns(2).Columnwidth = 20
> ObjSheet.Columns(3).Columnwidth = 17
> ObjSheet.Columns(4).Columnwidth = 16
> ObjSheet.Columns(5).Columnwidth = 27
> objSheet.Range("C2:C10000").HorizontalAlignment = -4108
> objSheet.Range("D2:D10000").HorizontalAlignment = -4108
> objSheet.Range("E2:E10000").HorizontalAlignment = -4108
> objSheet.Cells(1, 1).Value = "Display Name"
> objSheet.Cells(1, 2).Value = "Use MBX Store Defaults"
> objSheet.Cells(1, 3).Value = "Issue Warning (KB)"
> objSheet.Cells(1, 4).Value = "Prohibit Send (KB)"
> objSheet.Cells(1, 5).Value = "Prohibit Send and Recieve (KB)"
> '-- Query AD for mailbox limit information.
> Do While infile.AtEndOfStream <> True
> strLine = infile.ReadLine
> If n > nA Then
> progBar.document.write "<font color=blue>"
> progBar.document.write "|"
> progBar.document.title = "Enumerating Acct Info..."
> n=0
> End If
> arrdisplayName = Split(strLine, VbCrLf)
> strdisplayName = arrdisplayName(0)
> Set objRootDSE = GetObject("LDAP://rootDSE")
> strADsPath = "LDAP://" & objRootDSE.Get("defaultNamingContext")
> Set objConnection = CreateObject("ADODB.Connection")
> objConnection.Open "Provider=ADsDSOObject;"
> Set objCommand = CreateObject("ADODB.Command")
> objCommand.ActiveConnection = objConnection
> objCommand.CommandText = "SELECT
> distinguishedName,displayName,mDBStorage
Quota,mDBOverQuotaLimit,mDBOverHardQuota
Limit
> FROM 'LDAP://dc=dems,dc=mil,dc=ca' WHERE displayName = '" & strdisplayName &
> "'"
> objCommand.Properties("Page Size")= 1000
> Set objRecordSet = objCommand.Execute
> While Not objRecordset.EOF
> strADSPathA = objRecordset.Fields("distinguishedName")
> Set oUser = GetObject("LDAP://" & strADSPathA)
> objSheet.Cells(intRow, intCola).Value = oUser.displayName
> objSheet.Cells(intRow, intColb).Value = oUser.mDBUseDefaults
> objSheet.Cells(intRow, intColc).Value = oUser.mDBStorageQuota
> objSheet.Cells(intRow, intCold).Value = oUser.mDBOverQuotaLimit
> objSheet.Cells(intRow, intCole).Value = oUser.mDBOverHardQuotaLimit
> intRow = intRow+1
> objRecordset.MoveNext
> Wend
> n=n+1
> Loop
> progBar.quit
> objExcel.ActiveWorkbook.SaveAs strExcelPath
> objExcel.ActiveWorkbook.Close
> objExcel.Application.Quit
> infile.Close
> objFSO.DeleteFile(objTempFile)
> MsgBox "Report is located at C:\temp\Mailbox_quota.xls", "Report
> Completed"
> '-- Clean up.
> Set objRootDSE = Nothing
> Set objConnection = Nothing
> Set objCommand = Nothing
> Set objFSO = Nothing
> Else
> window.close()
> End If
> window.close()
> End Sub
> </SCRIPT>
> <body>
> <span id="Authentication"></span>
> </body>
> </html>
>
>
> "Al Mulnick" <amulnick_No_SPAM@ncDOTrr.com> wrote in message
> news:e$647wMfFHA.1248@TK2MSFTNGP12.phx.gbl...
>
>
>
>
Ramon Q

2005-09-16, 5:55 pm

Bernard,

I tried to cut and paste your code but fails to run. I'm not an expert on
vbscripting but just a thought perhaps you could post your code?

Thanks!
Ramon

"Bernard Chouinard" wrote:

> Here is an hta that will do what you want, you will need to change
> arrComputers and strDomain
> parameter in it to fit your environment . You will need excel installed. The
> result is saved in the temp directory but you can change that.
>
> <html>
> <head>
> <title>Authentication</title>
> <HTA:APPLICATION
> ID="objMailboxReport"
> APPLICATIONNAME="MailboxReport"
> SCROLL="no"
> SINGLEINSTANCE="yes"
> WINDOWSTATE="normal"
> </head>
> <style>
> BODY{background-color: buttonface; font-family: Helvetica; font-size: 10;}
> .button{font-family: arial; font-size: 10pt;}
> </style>
> <SCRIPT Language="VBScript">
> i=0
> Sub Window_Onload
> self.ResizeTo 210,200
> strHTML = strHTML & "<font style=""button"">"
> strHTML = strHTML & "<b>Enter your authentication credentials</b><hr>"
> strHTML = strHTML & "Domain: <input
> type=""text"" name=""DomainNameBox"" size=""15""><br>User Name: <input
> type=""text"" name=""UserNameBox""
> size=""15""><br>Password: <input type=""password""
> name=""PasswordArea"" size=""15"">"
> strHTML = strHTML & "<input id=runbutton class=""button"" type=""button""
> value=""Submit"" name=""run_button"" onClick=""RunScript"">"
> Authentication.InnerHTML = strHTML
> End Sub
> Sub RunScript
> ConfirmRun = MsgBox ("This process will search through all the Exchange
> Servers in order" & VbCrLf _
> & "to enumerate mailboxes and their sizes in addition to querying
> AD" & VbCrLf _
> & "using RootDSE to enumerate mailbox limit attributes. This
> process" & VbCrLf _
> & "will take a long time to complete and will consume a portion
> of local" & VbCrLf _
> & "resources during processing. Are you sure you wish to
> continue?", _
> 68, "Run Mailbox Size and Quota Report")
> If ConfirmRun = 6 Then
> On Error Resume Next
> '-- Check to see if Excel is installed.
> Set objExcel = CreateObject("Excel.Application")
> If Err.Number <> 0 Then
> On Error GoTo 0
> WScript.Echo "Excel application not found."
> WScript.Quit
> End If
> Set objFSO = CreateObject("Scripting.FileSystemObject")
> objName = objFSO.GetTempName
> objTempFile = objName
> Set outfile = objFSO.OpenTextFile(objTempFile, 2, True)
> objExcel.Workbooks.Add
> '-- Format the spreadsheet.
> Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
> objSheet.Range("A1:C10000").Font.Size = 8
> objSheet.Range("A1:C1").Font.Bold = True
> objSheet.Name = "MBX Size"
> ObjSheet.Columns(1).Columnwidth = 20
> ObjSheet.Columns(2).Columnwidth = 14
> ObjSheet.Columns(3).Columnwidth = 8
> intRow = 2
> intCola = 1
> intColb = 2
> intColc = 3
> intCold = 4
> intCole = 5
> objSheet.Cells(1, 1).Value = "MailboxDisplayName"
> objSheet.Cells(1, 2).Value = "ServerName"
> objSheet.Cells(1, 3).Value = "Size(KB)"
> strExcelPath = "C:\temp\Mailbox_Quota.xls"
> Const wbemFlagReturnImmediately = &h10
> Const wbemFlagForwardOnly = &h20
> g=0
> '-- Edit this line to change servers queried.
> arrComputers = Array("server1","server2")
> '-- Edit this line to reflect the domain where the mail server reside.
> strDomain = "Domainname"
> strCount = UBound(arrComputers)
> '-- Query the Exchange servers in the array.
> For Each strComputer In arrComputers
> strCountA = strCount-1
> Set objCompName = GetObject("WinNT://" & strDomain & "/" & strComputer)
> Set progBar = CreateObject("internetexplorer.application")
> progBar.navigate2 "about :blank" : progBar.width = 350 : progBar.height =
> 120 : progBar.toolbar = false : progBar.menubar = False : progBar.statusbar
> = False : progBar.visible = True
> progBar.document.write "<font color=blue>"
> progBar.document.write "Querying data from " & objCompName.Name & "<br>
> (" & strCountA & " remaining)"
> progBar.document.title = "Current Progress..."
> Set SWbemLocator = CreateObject("WbemScripting.SWBemlocator")
> Set objWMIService = SWBemlocator.ConnectServer _
> (strComputer, "root\MicrosoftExchangeV2", _
> DomainNameBox.Value & "\" & UserNameBox.Value, PasswordArea.Value)
> Set colItems = objWMIService.ExecQuery("SELECT * FROM Exchange_Mailbox",
> "WQL", _
> wbemFlagReturnImmediately + wbemFlagForwardOnly)
> For Each objItem In colItems
> outfile.writeline objItem.MailboxDisplayName
> objSheet.Cells(intRow, intCola).Value = objItem.MailboxDisplayName
> objSheet.Cells(intRow, intColb).Value = objItem.ServerName
> objSheet.Cells(intRow, intColc).Value = objItem.Size
> intRow = intRow+1
> g=g+1
> Next
> progBar.quit
> Next
> outfile.close
> intRow=2
> n1 = g/100
> nA = Round(n1, 0)
> n = 0
> '-- Format the second worksheet.
> Set objSheet = objExcel.ActiveWorkbook.Worksheets(2)
> Set infile = objFSO.OpenTextFile(objTempFile)
> Set progBar = CreateObject("internetexplorer.application")
> progBar.navigate2 "about :blank" : progBar.width = 350 : progBar.height =
> 80 : progBar.toolbar = false : progBar.menubar = False : progBar.statusbar =
> False : progBar.visible = True
> objSheet.Range("A1:E10000").Font.Size = 8
> objSheet.Range("A1:E1").Font.Bold = True
> objSheet.Name = "MBX Quota"
> ObjSheet.Columns(1).Columnwidth = 20
> ObjSheet.Columns(2).Columnwidth = 20
> ObjSheet.Columns(3).Columnwidth = 17
> ObjSheet.Columns(4).Columnwidth = 16
> ObjSheet.Columns(5).Columnwidth = 27
> objSheet.Range("C2:C10000").HorizontalAlignment = -4108
> objSheet.Range("D2:D10000").HorizontalAlignment = -4108
> objSheet.Range("E2:E10000").HorizontalAlignment = -4108
> objSheet.Cells(1, 1).Value = "Display Name"
> objSheet.Cells(1, 2).Value = "Use MBX Store Defaults"
> objSheet.Cells(1, 3).Value = "Issue Warning (KB)"
> objSheet.Cells(1, 4).Value = "Prohibit Send (KB)"
> objSheet.Cells(1, 5).Value = "Prohibit Send and Recieve (KB)"
> '-- Query AD for mailbox limit information.
> Do While infile.AtEndOfStream <> True
> strLine = infile.ReadLine
> If n > nA Then
> progBar.document.write "<font color=blue>"
> progBar.document.write "|"
> progBar.document.title = "Enumerating Acct Info..."
> n=0
> End If
> arrdisplayName = Split(strLine, VbCrLf)
> strdisplayName = arrdisplayName(0)
> Set objRootDSE = GetObject("LDAP://rootDSE")
> strADsPath = "LDAP://" & objRootDSE.Get("defaultNamingContext")
> Set objConnection = CreateObject("ADODB.Connection")
> objConnection.Open "Provider=ADsDSOObject;"
> Set objCommand = CreateObject("ADODB.Command")
> objCommand.ActiveConnection = objConnection
> objCommand.CommandText = "SELECT
> distinguishedName,displayName,mDBStorage
Quota,mDBOverQuotaLimit,mDBOverHardQuota
Limit
> FROM 'LDAP://dc=dems,dc=mil,dc=ca' WHERE displayName = '" & strdisplayName &
> "'"
> objCommand.Properties("Page Size")= 1000
> Set objRecordSet = objCommand.Execute
> While Not objRecordset.EOF
> strADSPathA = objRecordset.Fields("distinguishedName")
> Set oUser = GetObject("LDAP://" & strADSPathA)
> objSheet.Cells(intRow, intCola).Value = oUser.displayName
> objSheet.Cells(intRow, intColb).Value = oUser.mDBUseDefaults
> objSheet.Cells(intRow, intColc).Value = oUser.mDBStorageQuota
> objSheet.Cells(intRow, intCold).Value = oUser.mDBOverQuotaLimit
> objSheet.Cells(intRow, intCole).Value = oUser.mDBOverHardQuotaLimit
> intRow = intRow+1
> objRecordset.MoveNext
> Wend
> n=n+1
> Loop
> progBar.quit
> objExcel.ActiveWorkbook.SaveAs strExcelPath
> objExcel.ActiveWorkbook.Close
> objExcel.Application.Quit
> infile.Close
> objFSO.DeleteFile(objTempFile)
> MsgBox "Report is located at C:\temp\Mailbox_quota.xls", "Report
> Completed"
> '-- Clean up.
> Set objRootDSE = Nothing
> Set objConnection = Nothing
> Set objCommand = Nothing
> Set objFSO = Nothing
> Else
> window.close()
> End If
> window.close()
> End Sub
> </SCRIPT>
> <body>
> <span id="Authentication"></span>
> </body>
> </html>
>
>
> "Al Mulnick" <amulnick_No_SPAM@ncDOTrr.com> wrote in message
> news:e$647wMfFHA.1248@TK2MSFTNGP12.phx.gbl...
>
>
>
>
Sponsored Links






Free braindumps | Software forum | Database administration forum

Copyright 2003 - 2009 webservertalk.com