asked on

script to retrun return all AD users and also there Exchange 2003 Mailbox size / last login time

Hi All

I have been asked to generate a report accross our entire estate (5 Win 2003 Domains, 10 Exchange 2003 servers, 10'000 + Users to retun certain attributes like last logon time, email address etc which is straigh forward enough, however the report also needs to list the users last mailbox login and mailbox size, as this is not stored in AD i need some way to link an AD query and expand that out to also Query exchange and then output to a csv

Is this possible?

Thanks

vinsvin

There are many tools and utilities designed to do so, but none are native W2K GUI. There are no graphical or command line utilities that produce comprehensive reports on groups, users and permissions included with the Windows Operating System or the Resource Kit. The NET commands and the Windows Resource Kit ADDUSERS.EXE and PERMS.EXE utilities can be used to create limited administrative reports by piping the output to a text file.

Limited report generation is possible through the following commands:

Note: Removal of the /domain switch will generate a report for the local machine.

NET USERS /DOMAIN >USERS.TXT

This command will return the user accounts from the Primary Domain Controller (PDC) of the current domain, and write them to a file called USER.TXT

NET ACCOUNTS /DOMAIN >ACCOUNTS.TXT

This command will return the account policy information from the PDC of the current domain, and write it to a file called ACCOUNTS.TXT

NET CONFIG SERVER >SERVER.TXT

This command will return the server name, version of Windows, active network adapter information/MAC address, Server hidden status, Maximum Logged On Users, Maximum open files per session, Idle session time, and assign it to a file called SERVER.TXT

NET CONFIG WORKSTATION >WKST.TXT

This command will return the workstation name, user name, version of Windows, network adapter, network adapter information/MAC address, Logon domain, COM Open Timeout, COM Send Count, COM Send Timout, and write it to a file called WKST.TXT.

NET GROUP /DOMAIN >DGRP.TXT

This command will return the global groups on the PDC of the current domain, and write them to a file called GRP.TXT.

NET LOCALGROUP >LGRP.TXT

This command will return the local groups on the local machine, and write them to a file call LGRP.TXT.

NET VIEW /DOMAIN:DOMAINNAME >VIEW.TXT

This command will return the resources in the specified domain, and write them to a file called VIEW.TXT.

vinsvin

Exports Active Directory user information to a coma-separated values file.

See the VBS file enclosed
ADUsers.VBS

prashanthd

try the following..

'===============================================================================
' ExchMailBoxStats.vbs
'===============================================================================
' Purpose:
' Create a CSV Exchange Mailbox Statistics Report
'===============================================================================
' Reference:
' http://msdn.microsoft.com/en-us/library/aa143732.aspx
'===============================================================================
' Syntax:
' cscript //NoLogo ExchMailBoxStats.vbs
'===============================================================================


Option Explicit

Dim sOutputFile: sOutputFile = OutputFileName()
WScript.Echo Now & " - Starting " & WScript.ScriptName & " script"
Dim arrServerNames: arrServerNames = Split(GetExchangeServers(),",")
Dim dicStores: Set dicStores = CreateObject("Scripting.Dictionary"): dicStores.CompareMode = 1
CreateStoresDictionary
CreateMailboxStatsReport
WScript.Echo "Mailbox Statistics Report completed: " & sOutputFile
WScript.Echo Now & " - " & WScript.ScriptName & " finished!"

Function OutputFileName()
	OutputFileName = Left(WScript.ScriptFullName, Len(WScript.ScriptFullName)-3) & _
		ReverseDate() & ".csv"
End Function

Function ReverseDate()
	Dim dt: dt = date(): dt = Year(dt)*1e4 + Month(dt)*1e2 + Day(dt)
	ReverseDate = dt
End Function

Sub AppendToLog(sData)
	With CreateObject("Scripting.FileSystemObject")._
		OpenTextFile(sOutputFile, 8, True)
		.Write sData & vbNewLine: .Close
	End With 
End Sub

Function GetExchangeServers()
	Dim oConn, oCmd, oRs
	Dim sCNC, sFilter, sQuery, sOutput
	Set oConn = Createobject("ADODB.Connection")
	Set oCmd = Createobject("ADODB.Command")
	Set oRs = Createobject("ADODB.Recordset")
	sCNC = "CN=Microsoft Exchange,CN=Services," & _
					GetObject("LDAP://RootDSE").Get("configurationNamingContext")
	sFilter = "(&(objectCategory=msExchExchangeServer)(objectClass=msExchExchangeServer))"
	sQuery = "<LDAP://" & sCNC & ">;" & sFilter & ";name;subtree"
	oConn.Provider = "ADsDSOObject"
	oConn.Open "ADs Provider"
	Wscript.Echo "Querying ActiveDirectory for Exchange Servers..."
	oCmd.ActiveConnection = oConn
	oCmd.CommandText = sQuery
	Set oRs = oCmd.Execute
	While Not oRs.EOF
		WScript.Echo "Found Exchange Server: " & oRs.Fields("name")
		sOutput = sOutput & oRs.Fields("name") & ","
		oRs.MoveNext
	Wend
	If Right(sOutput,1) = "," Then sOutput = Left(sOutput,(Len(sOutput))-1)
	WScript.Echo "Exchange Servers found in ActiveDirectory: " & sOutput
	oRs.Close(): Set oRs = Nothing
	Set oCmd = Nothing
	oConn.Close(): Set oConn = Nothing
	GetExchangeServers = sOutput
End Function

Sub CreateStoresDictionary
	Dim sCNC, sQuery, sFilter
	Dim sStoreNameDictEntry, sStorePolicyDictEntry, oPolicy, sPolicyDN
	sCNC = "CN=Microsoft Exchange,CN=Services," & _
				GetObject("LDAP://RootDSE").Get("configurationNamingContext")
	Dim oConn: Set oConn = CreateObject("ADODB.Connection")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Dim oCmd: Set oCmd = CreateObject("ADODB.Command")
	oCmd.ActiveConnection = oConn
	oCmd.Properties("page size") = 15000
	sFilter = "(&(objectClass=msExchPrivateMDB)(!objectClass=msExchPrivateMDBPolicy))"
	sQuery = "<LDAP://" & sCNC & ">;" & _
		sFilter & ";cn,mDBStorageQuota,mDBOverQuotaLimit,mDBOverHardQuotaLimit;subtree"
	oCmd.CommandText = sQuery
	oCmd.Properties("Page Size") = 15000
	oCmd.Properties("Timeout") = 90
	WScript.Echo "Querying Exchange Information Stores Quota Settings..."
	Dim oRs: Set oRs = Createobject("ADODB.Recordset")
	Set oRs = oCmd.Execute
	If oRs.RecordCount > 0 Then
		oRs.MoveFirst
		Do Until oRs.EOF
		  	sStoreNameDictEntry = oRs.Fields("cn")

			If IsNull(oRs.Fields("mDBStorageQuota")) Then
				sStorePolicyDictEntry = "Unlimited,"
			Else
				sStorePolicyDictEntry = ReportSize(oRs.Fields("mDBStorageQuota")) & ","
			End If
				
			If IsNull(oRs.Fields("mDBOverQuotaLimit")) Then
				sStorePolicyDictEntry = sStorePolicyDictEntry & "Unlimited,"
			Else
				sStorePolicyDictEntry = sStorePolicyDictEntry & ReportSize(oRs.Fields("mDBOverQuotaLimit")) & ","
			End If
			
			If IsNull(oRs.Fields("mDBOverHardQuotaLimit")) Then
				sStorePolicyDictEntry = sStorePolicyDictEntry & "Unlimited,"
			Else
				sStorePolicyDictEntry = sStorePolicyDictEntry & ReportSize(oRs.Fields("mDBOverHardQuotaLimit")) & ","
			End If
			
			sStorePolicyDictEntry = sStorePolicyDictEntry & "Mailbox Store"
			If Not dicStores.Exists(sStoreNameDictEntry) Then _
				dicStores.Add sStoreNameDictEntry, sStorePolicyDictEntry
			oRs.MoveNext
		Loop
	End If
	oRs.Close(): Set oRs = Nothing
	Set oCmd = Nothing
	oConn.Close(): Set oConn = Nothing
End Sub


Sub CreateMailboxStatsReport
	On Error Resume Next
	Dim sServer, oWMIExchange, oMailboxes, oMailbox, sOutLine
	If UBound(arrServerNames) >= 0 Then
		AppendToLog "Account Name,User Principal Name,Display Name,EMail,Issue Warning,Prohibit Send,Prohibit Send and Receive,Quota Set Level,Limit Status,Mailbox Size,Total Items,Mailbox Location"
		WScript.Echo "Querying Exchange Servers For Mailboxes..."
		For Each sServer in arrServerNames
			Set oWMIExchange = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & _
								sServer & "/root/MicrosoftExchangeV2")
			If Err.Number <> 0 Then
				WScript.Echo "Unable to connect to the " & sServer & _
					"/root/MicrosoftExchangeV2 namespace."
			Else
				Set oMailboxes = oWMIExchange.ExecQuery("SELECT * FROM Exchange_Mailbox WHERE NOT LegacyDN LIKE '%SYSTEMMAILBOX%' AND NOT LegacyDN LIKE '%CN=CONFIGURATION/%'")
				If (oMailboxes.count > 0) Then
					For Each oMailbox in oMailboxes
						If oMailbox.DateDiscoveredAbsentInDS <> "" Then
							sOutLine = "[Disconnected Mailbox],N/A,N/A,N/A,N/A,N/A,N/A,N/A," & _
										LimitStatus(oMailbox.StorageLimitInfo) & "," & ReportSize(oMailbox.Size) & "," & oMailbox.TotalItems & "," & _
											oMailbox.ServerName & "\" & oMailbox.StorageGroupName &  "\" & oMailbox.StoreName & "\" & oMailbox.MailboxDisplayName
						Else
							sOutLine = GetMailboxStatsFromAD(oMailbox.LegacyDN) & "," & _
										LimitStatus(oMailbox.StorageLimitInfo) & "," & ReportSize(oMailbox.Size) & "," & oMailbox.TotalItems & "," & _
											oMailbox.ServerName & "\" & oMailbox.StorageGroupName &  "\" & oMailbox.StoreName & "\" & oMailbox.MailboxDisplayName
						End If
						AppendToLog sOutLine
	  				Next
				End If
				Set oMailbox = Nothing
				Set oMailboxes = Nothing
			End If
		Next
		Set oWMIExchange = Nothing
	Else
		WScript.Echo "No Exchange Servers found in ActiveDirectory"
	End If
End Sub


Function GetMailboxStatsFromAD(legacyExchangeDN)
	Dim sRootDSE, sQuery, sFilter, sFields, sRet, sHomeMDBCn
	Dim sSamAccountName, sUserPrincipalName, sDisplayName, sMail, sQuota
	sRootDSE = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
	Dim oConn: Set oConn = CreateObject("ADODB.Connection")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Dim oCmd: Set oCmd = CreateObject("ADODB.Command")
	oCmd.ActiveConnection = oConn
	oCmd.Properties("page size") = 15000
	sFilter = "(&(ObjectClass=user)(ObjectCategory=person)(legacyExchangeDN=" & legacyExchangeDN & "))"
	sFields = "samAccountName,userPrincipalName,displayName,mail,mDBUseDefaults,mDBStorageQuota,mDBOverQuotaLimit,mDBOverHardQuotaLimit,homeMDB"
	sQuery = "<LDAP://" & sRootDSE & ">;" & sFilter & ";" & sFields & ";subtree"
	oCmd.CommandText = sQuery
	oCmd.Properties("Page Size") = 15000
	oCmd.Properties("Timeout") = 90
	Dim oRs: Set oRs = Createobject("ADODB.Recordset")
	Set oRs = oCmd.Execute
	If oRs.RecordCount > 0 Then
		oRs.MoveFirst
		Do Until oRs.EOF
				
			If IsNull(oRs.Fields("samAccountName")) Then
				sSamAccountName = "N/A"
			Else
				sSamAccountName = oRs.Fields("samAccountName")
			End If
			
			If IsNull(oRs.Fields("userPrincipalName")) Then
				sUserPrincipalName = "N/A"
			Else
				sUserPrincipalName = oRs.Fields("userPrincipalName")
			End If
			
			If IsNull(oRs.Fields("displayName")) Then
				sDisplayName = "N/A"
			Else
				sDisplayName = Trim(oRs.Fields("displayName"))
			End If
			
			If IsNull(oRs.Fields("mail")) Then
				sMail = "N/A"
			Else
				sMail = oRs.Fields("mail")
			End If
			
			sRet = sSamAccountName & "," & sUserPrincipalName & "," & _
					sDisplayName & "," & sMail

			If Not CBool(oRs.Fields("mDBUseDefaults")) Then
				If IsNull(oRs.Fields("mDBStorageQuota")) Then
					sQuota = "Unlimited"
				Else
					sQuota = ReportSize(oRs.Fields("mDBStorageQuota"))
				End If
				
				If IsNull(oRs.Fields("mDBOverQuotaLimit")) Then
					sQuota = sQuota & "," & "Unlimited"
				Else
					sQuota = sQuota & "," & ReportSize(oRs.Fields("mDBOverQuotaLimit"))
				End If
				
				If IsNull(oRs.Fields("mDBOverHardQuotaLimit")) Then
					sQuota = sQuota & "," & "Unlimited"
				Else
					sQuota = sQuota & "," & ReportSize(oRs.Fields("mDBOverHardQuotaLimit"))
				End If
				
				sRet = sRet & "," & sQuota & ",User"
			Else
				sHomeMDBCn = GetObject("LDAP://" & oRs.Fields("homeMDB")).cn
				If dicStores.Exists(sHomeMDBCn) Then
					sRet = sRet & "," & dicStores.Item(sHomeMDBCn)
				Else
					sRet = sRet & ",UnKnown,UnKnown,UnKnown,UnKnown"
				End If
			End If
			oRs.MoveNext
		Loop
	End If
	oRs.Close(): Set oRs = Nothing
	Set oCmd = Nothing
	oConn.Close(): Set oConn = Nothing
	GetMailboxStatsFromAD = sRet
End Function


Function ReportSize(iSize)
	Dim sUnit, i: i = 0
	While iSize > 1000
		iSize = Round(((iSize)/1024),2)
		i = i + 1
	Wend
	Select Case i
		Case 0: sUnit = " KB"
		Case 1: sUnit = " MB"
		Case 2: sUnit = " GB"
		Case 3: sUnit = " TB"
		Case 4: sUnit = " PB"
	End Select
	ReportSize = iSize & sUnit
End Function


Function LimitStatus(iStatus)
	Dim sRet: sRet = "UnKnown"
	Select Case iStatus
		Case 1: sRet = "Below Limit"
		Case 2: sRet = "Issue Warning"
		Case 4: sRet = "Prohibit Send"
		Case 8: sRet = "No Checking"
		Case 16: sRet = "Mailbox Disabled"
		Case Else: sRet= "UnKnown"
	End Select
	LimitStatus = sRet
End Function

Open in new window

morpheios

Use script from this article
http://www.servercare.nl/Lists/Posts/Post.aspx?List=f9fb19de%2D694c%2D4b82%2D993a%2Dff0ca97ea371&ID=20

ncomper

ASKER

Hi Prashanthd

Your script worked well on my lab, is it possible to modify it so it also gives me last logon time (sorry to ask such a simple one by my VBscripting skills are minimal,

Also in my live Environment i have a forest with a root domain and 4 child domains, Exchange servers are in all domains, will this script attach to root of forest and intergogate all domains or will it only run against the domain that i am logged into when running the script

Thanks

prashanthd

Modified the script to return LastLogonTime.

Yes...this will return all the exchange servers.

'===============================================================================
' ExchMailBoxStats.vbs
'===============================================================================
' Purpose:
' Create a CSV Exchange Mailbox Statistics Report
'===============================================================================
' Reference:
' http://msdn.microsoft.com/en-us/library/aa143732.aspx
'===============================================================================
' Syntax:
' cscript //NoLogo ExchMailBoxStats.vbs
'===============================================================================


Option Explicit

Dim sOutputFile: sOutputFile = OutputFileName()
WScript.Echo Now & " - Starting " & WScript.ScriptName & " script"
Dim arrServerNames: arrServerNames = Split(GetExchangeServers(),",")
Dim dicStores: Set dicStores = CreateObject("Scripting.Dictionary"): dicStores.CompareMode = 1
CreateStoresDictionary
CreateMailboxStatsReport
WScript.Echo "Mailbox Statistics Report completed: " & sOutputFile
WScript.Echo Now & " - " & WScript.ScriptName & " finished!"

Function OutputFileName()
	OutputFileName = Left(WScript.ScriptFullName, Len(WScript.ScriptFullName)-3) & _
		ReverseDate() & ".csv"
End Function

Function ReverseDate()
	Dim dt: dt = date(): dt = Year(dt)*1e4 + Month(dt)*1e2 + Day(dt)
	ReverseDate = dt
End Function

Sub AppendToLog(sData)
	With CreateObject("Scripting.FileSystemObject")._
		OpenTextFile(sOutputFile, 8, True)
		.Write sData & vbNewLine: .Close
	End With 
End Sub

Function GetExchangeServers()
	Dim oConn, oCmd, oRs
	Dim sCNC, sFilter, sQuery, sOutput
	Set oConn = Createobject("ADODB.Connection")
	Set oCmd = Createobject("ADODB.Command")
	Set oRs = Createobject("ADODB.Recordset")
	sCNC = "CN=Microsoft Exchange,CN=Services," & _
					GetObject("LDAP://RootDSE").Get("configurationNamingContext")
	sFilter = "(&(objectCategory=msExchExchangeServer)(objectClass=msExchExchangeServer))"
	sQuery = "<LDAP://" & sCNC & ">;" & sFilter & ";name;subtree"
	oConn.Provider = "ADsDSOObject"
	oConn.Open "ADs Provider"
	Wscript.Echo "Querying ActiveDirectory for Exchange Servers..."
	oCmd.ActiveConnection = oConn
	oCmd.CommandText = sQuery
	Set oRs = oCmd.Execute
	While Not oRs.EOF
		WScript.Echo "Found Exchange Server: " & oRs.Fields("name")
		sOutput = sOutput & oRs.Fields("name") & ","
		oRs.MoveNext
	Wend
	If Right(sOutput,1) = "," Then sOutput = Left(sOutput,(Len(sOutput))-1)
	WScript.Echo "Exchange Servers found in ActiveDirectory: " & sOutput
	oRs.Close(): Set oRs = Nothing
	Set oCmd = Nothing
	oConn.Close(): Set oConn = Nothing
	GetExchangeServers = sOutput
End Function

Sub CreateStoresDictionary
	Dim sCNC, sQuery, sFilter
	Dim sStoreNameDictEntry, sStorePolicyDictEntry, oPolicy, sPolicyDN
	sCNC = "CN=Microsoft Exchange,CN=Services," & _
				GetObject("LDAP://RootDSE").Get("configurationNamingContext")
	Dim oConn: Set oConn = CreateObject("ADODB.Connection")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Dim oCmd: Set oCmd = CreateObject("ADODB.Command")
	oCmd.ActiveConnection = oConn
	oCmd.Properties("page size") = 15000
	sFilter = "(&(objectClass=msExchPrivateMDB)(!objectClass=msExchPrivateMDBPolicy))"
	sQuery = "<LDAP://" & sCNC & ">;" & _
		sFilter & ";cn,mDBStorageQuota,mDBOverQuotaLimit,mDBOverHardQuotaLimit;subtree"
	oCmd.CommandText = sQuery
	oCmd.Properties("Page Size") = 15000
	oCmd.Properties("Timeout") = 90
	WScript.Echo "Querying Exchange Information Stores Quota Settings..."
	Dim oRs: Set oRs = Createobject("ADODB.Recordset")
	Set oRs = oCmd.Execute
	If oRs.RecordCount > 0 Then
		oRs.MoveFirst
		Do Until oRs.EOF
		  	sStoreNameDictEntry = oRs.Fields("cn")

			If IsNull(oRs.Fields("mDBStorageQuota")) Then
				sStorePolicyDictEntry = "Unlimited,"
			Else
				sStorePolicyDictEntry = ReportSize(oRs.Fields("mDBStorageQuota")) & ","
			End If
				
			If IsNull(oRs.Fields("mDBOverQuotaLimit")) Then
				sStorePolicyDictEntry = sStorePolicyDictEntry & "Unlimited,"
			Else
				sStorePolicyDictEntry = sStorePolicyDictEntry & ReportSize(oRs.Fields("mDBOverQuotaLimit")) & ","
			End If
			
			If IsNull(oRs.Fields("mDBOverHardQuotaLimit")) Then
				sStorePolicyDictEntry = sStorePolicyDictEntry & "Unlimited,"
			Else
				sStorePolicyDictEntry = sStorePolicyDictEntry & ReportSize(oRs.Fields("mDBOverHardQuotaLimit")) & ","
			End If
			
			sStorePolicyDictEntry = sStorePolicyDictEntry & "Mailbox Store"
			If Not dicStores.Exists(sStoreNameDictEntry) Then _
				dicStores.Add sStoreNameDictEntry, sStorePolicyDictEntry
			oRs.MoveNext
		Loop
	End If
	oRs.Close(): Set oRs = Nothing
	Set oCmd = Nothing
	oConn.Close(): Set oConn = Nothing
End Sub


Sub CreateMailboxStatsReport
	On Error Resume Next
	Dim sServer, oWMIExchange, oMailboxes, oMailbox, sOutLine
	If UBound(arrServerNames) >= 0 Then
		AppendToLog "Account Name,User Principal Name,Display Name,EMail,Issue Warning,Prohibit Send,Prohibit Send and Receive,Quota Set Level,Limit Status,Mailbox Size,Total Items,Mailbox Location,LastLogonTime"
		WScript.Echo "Querying Exchange Servers For Mailboxes..."
		For Each sServer in arrServerNames
			Set oWMIExchange = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & _
								sServer & "/root/MicrosoftExchangeV2")
			If Err.Number <> 0 Then
				WScript.Echo "Unable to connect to the " & sServer & _
					"/root/MicrosoftExchangeV2 namespace."
			Else
				Set oMailboxes = oWMIExchange.ExecQuery("SELECT * FROM Exchange_Mailbox WHERE NOT LegacyDN LIKE '%SYSTEMMAILBOX%' AND NOT LegacyDN LIKE '%CN=CONFIGURATION/%'")
				If (oMailboxes.count > 0) Then
					For Each oMailbox in oMailboxes
						If oMailbox.DateDiscoveredAbsentInDS <> "" Then
							sOutLine = "[Disconnected Mailbox],N/A,N/A,N/A,N/A,N/A,N/A,N/A," & _
										LimitStatus(oMailbox.StorageLimitInfo) & "," & ReportSize(oMailbox.Size) & "," & oMailbox.TotalItems & "," & _
											oMailbox.ServerName & "\" & oMailbox.StorageGroupName &  "\" & oMailbox.StoreName & "\" & oMailbox.MailboxDisplayName &","& oMailbox.LastLogonTime
						Else
							sOutLine = GetMailboxStatsFromAD(oMailbox.LegacyDN) & "," & _
										LimitStatus(oMailbox.StorageLimitInfo) & "," & ReportSize(oMailbox.Size) & "," & oMailbox.TotalItems & "," & _
											oMailbox.ServerName & "\" & oMailbox.StorageGroupName &  "\" & oMailbox.StoreName & "\" & oMailbox.MailboxDisplayName &","& oMailbox.LastLogonTime
						End If
						AppendToLog sOutLine
	  				Next
				End If
				Set oMailbox = Nothing
				Set oMailboxes = Nothing
			End If
		Next
		Set oWMIExchange = Nothing
	Else
		WScript.Echo "No Exchange Servers found in ActiveDirectory"
	End If
End Sub


Function GetMailboxStatsFromAD(legacyExchangeDN)
	Dim sRootDSE, sQuery, sFilter, sFields, sRet, sHomeMDBCn
	Dim sSamAccountName, sUserPrincipalName, sDisplayName, sMail, sQuota
	sRootDSE = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
	Dim oConn: Set oConn = CreateObject("ADODB.Connection")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Dim oCmd: Set oCmd = CreateObject("ADODB.Command")
	oCmd.ActiveConnection = oConn
	oCmd.Properties("page size") = 15000
	sFilter = "(&(ObjectClass=user)(ObjectCategory=person)(legacyExchangeDN=" & legacyExchangeDN & "))"
	sFields = "samAccountName,userPrincipalName,displayName,mail,mDBUseDefaults,mDBStorageQuota,mDBOverQuotaLimit,mDBOverHardQuotaLimit,homeMDB"
	sQuery = "<LDAP://" & sRootDSE & ">;" & sFilter & ";" & sFields & ";subtree"
	oCmd.CommandText = sQuery
	oCmd.Properties("Page Size") = 15000
	oCmd.Properties("Timeout") = 90
	Dim oRs: Set oRs = Createobject("ADODB.Recordset")
	Set oRs = oCmd.Execute
	If oRs.RecordCount > 0 Then
		oRs.MoveFirst
		Do Until oRs.EOF
				
			If IsNull(oRs.Fields("samAccountName")) Then
				sSamAccountName = "N/A"
			Else
				sSamAccountName = oRs.Fields("samAccountName")
			End If
			
			If IsNull(oRs.Fields("userPrincipalName")) Then
				sUserPrincipalName = "N/A"
			Else
				sUserPrincipalName = oRs.Fields("userPrincipalName")
			End If
			
			If IsNull(oRs.Fields("displayName")) Then
				sDisplayName = "N/A"
			Else
				sDisplayName = Trim(oRs.Fields("displayName"))
			End If
			
			If IsNull(oRs.Fields("mail")) Then
				sMail = "N/A"
			Else
				sMail = oRs.Fields("mail")
			End If
			
			sRet = sSamAccountName & "," & sUserPrincipalName & "," & _
					sDisplayName & "," & sMail

			If Not CBool(oRs.Fields("mDBUseDefaults")) Then
				If IsNull(oRs.Fields("mDBStorageQuota")) Then
					sQuota = "Unlimited"
				Else
					sQuota = ReportSize(oRs.Fields("mDBStorageQuota"))
				End If
				
				If IsNull(oRs.Fields("mDBOverQuotaLimit")) Then
					sQuota = sQuota & "," & "Unlimited"
				Else
					sQuota = sQuota & "," & ReportSize(oRs.Fields("mDBOverQuotaLimit"))
				End If
				
				If IsNull(oRs.Fields("mDBOverHardQuotaLimit")) Then
					sQuota = sQuota & "," & "Unlimited"
				Else
					sQuota = sQuota & "," & ReportSize(oRs.Fields("mDBOverHardQuotaLimit"))
				End If
				
				sRet = sRet & "," & sQuota & ",User"
			Else
				sHomeMDBCn = GetObject("LDAP://" & oRs.Fields("homeMDB")).cn
				If dicStores.Exists(sHomeMDBCn) Then
					sRet = sRet & "," & dicStores.Item(sHomeMDBCn)
				Else
					sRet = sRet & ",UnKnown,UnKnown,UnKnown,UnKnown"
				End If
			End If
			oRs.MoveNext
		Loop
	End If
	oRs.Close(): Set oRs = Nothing
	Set oCmd = Nothing
	oConn.Close(): Set oConn = Nothing
	GetMailboxStatsFromAD = sRet
End Function


Function ReportSize(iSize)
	Dim sUnit, i: i = 0
	While iSize > 1000
		iSize = Round(((iSize)/1024),2)
		i = i + 1
	Wend
	Select Case i
		Case 0: sUnit = " KB"
		Case 1: sUnit = " MB"
		Case 2: sUnit = " GB"
		Case 3: sUnit = " TB"
		Case 4: sUnit = " PB"
	End Select
	ReportSize = iSize & sUnit
End Function


Function LimitStatus(iStatus)
	Dim sRet: sRet = "UnKnown"
	Select Case iStatus
		Case 1: sRet = "Below Limit"
		Case 2: sRet = "Issue Warning"
		Case 4: sRet = "Prohibit Send"
		Case 8: sRet = "No Checking"
		Case 16: sRet = "Mailbox Disabled"
		Case Else: sRet= "UnKnown"
	End Select
	LimitStatus = sRet
End Function

Open in new window

ncomper

ASKER

Thanks for the quick turn around, just to confirm is that ythe last time the mailbox was logged onto?

prashanthd

yes...it is the last time the mailbox was logged onto.

ncomper

ASKER

Kool thanks, i have run it and realised it displays in the long number rather than the date

I found the link below that converts it, would you have time to add those lines to the right part of your script to do the conversion, i know that's a bit of an ask :)

http://blogs.technet.com/b/heyscriptingguy/archive/2010/01/27/dandelions-vcr-clocks-and-last-logon-times-these-are-a-few-of-our-least-favorite-things.aspx

Thanks

prashanthd

The link refers not to the mailbox lastlogon but LastLogonTimeStamp, anyway modified the script to format date.

'===============================================================================
' ExchMailBoxStats.vbs
'===============================================================================
' Purpose:
' Create a CSV Exchange Mailbox Statistics Report
'===============================================================================
' Reference:
' http://msdn.microsoft.com/en-us/library/aa143732.aspx
'===============================================================================
' Syntax:
' cscript //NoLogo ExchMailBoxStats.vbs
'===============================================================================


Option Explicit

Dim sOutputFile: sOutputFile = OutputFileName()
WScript.Echo Now & " - Starting " & WScript.ScriptName & " script"
Dim arrServerNames: arrServerNames = Split(GetExchangeServers(),",")
Dim dicStores: Set dicStores = CreateObject("Scripting.Dictionary"): dicStores.CompareMode = 1
CreateStoresDictionary
CreateMailboxStatsReport
WScript.Echo "Mailbox Statistics Report completed: " & sOutputFile
WScript.Echo Now & " - " & WScript.ScriptName & " finished!"

Function OutputFileName()
	OutputFileName = Left(WScript.ScriptFullName, Len(WScript.ScriptFullName)-3) & _
		ReverseDate() & ".csv"
End Function

Function ReverseDate()
	Dim dt: dt = date(): dt = Year(dt)*1e4 + Month(dt)*1e2 + Day(dt)
	ReverseDate = dt
End Function

Sub AppendToLog(sData)
	With CreateObject("Scripting.FileSystemObject")._
		OpenTextFile(sOutputFile, 8, True)
		.Write sData & vbNewLine: .Close
	End With 
End Sub

Function GetExchangeServers()
	Dim oConn, oCmd, oRs
	Dim sCNC, sFilter, sQuery, sOutput
	Set oConn = Createobject("ADODB.Connection")
	Set oCmd = Createobject("ADODB.Command")
	Set oRs = Createobject("ADODB.Recordset")
	sCNC = "CN=Microsoft Exchange,CN=Services," & _
					GetObject("LDAP://RootDSE").Get("configurationNamingContext")
	sFilter = "(&(objectCategory=msExchExchangeServer)(objectClass=msExchExchangeServer))"
	sQuery = "<LDAP://" & sCNC & ">;" & sFilter & ";name;subtree"
	oConn.Provider = "ADsDSOObject"
	oConn.Open "ADs Provider"
	Wscript.Echo "Querying ActiveDirectory for Exchange Servers..."
	oCmd.ActiveConnection = oConn
	oCmd.CommandText = sQuery
	Set oRs = oCmd.Execute
	While Not oRs.EOF
		WScript.Echo "Found Exchange Server: " & oRs.Fields("name")
		sOutput = sOutput & oRs.Fields("name") & ","
		oRs.MoveNext
	Wend
	If Right(sOutput,1) = "," Then sOutput = Left(sOutput,(Len(sOutput))-1)
	WScript.Echo "Exchange Servers found in ActiveDirectory: " & sOutput
	oRs.Close(): Set oRs = Nothing
	Set oCmd = Nothing
	oConn.Close(): Set oConn = Nothing
	GetExchangeServers = sOutput
End Function

Sub CreateStoresDictionary
	Dim sCNC, sQuery, sFilter
	Dim sStoreNameDictEntry, sStorePolicyDictEntry, oPolicy, sPolicyDN
	sCNC = "CN=Microsoft Exchange,CN=Services," & _
				GetObject("LDAP://RootDSE").Get("configurationNamingContext")
	Dim oConn: Set oConn = CreateObject("ADODB.Connection")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Dim oCmd: Set oCmd = CreateObject("ADODB.Command")
	oCmd.ActiveConnection = oConn
	oCmd.Properties("page size") = 15000
	sFilter = "(&(objectClass=msExchPrivateMDB)(!objectClass=msExchPrivateMDBPolicy))"
	sQuery = "<LDAP://" & sCNC & ">;" & _
		sFilter & ";cn,mDBStorageQuota,mDBOverQuotaLimit,mDBOverHardQuotaLimit;subtree"
	oCmd.CommandText = sQuery
	oCmd.Properties("Page Size") = 15000
	oCmd.Properties("Timeout") = 90
	WScript.Echo "Querying Exchange Information Stores Quota Settings..."
	Dim oRs: Set oRs = Createobject("ADODB.Recordset")
	Set oRs = oCmd.Execute
	If oRs.RecordCount > 0 Then
		oRs.MoveFirst
		Do Until oRs.EOF
		  	sStoreNameDictEntry = oRs.Fields("cn")

			If IsNull(oRs.Fields("mDBStorageQuota")) Then
				sStorePolicyDictEntry = "Unlimited,"
			Else
				sStorePolicyDictEntry = ReportSize(oRs.Fields("mDBStorageQuota")) & ","
			End If
				
			If IsNull(oRs.Fields("mDBOverQuotaLimit")) Then
				sStorePolicyDictEntry = sStorePolicyDictEntry & "Unlimited,"
			Else
				sStorePolicyDictEntry = sStorePolicyDictEntry & ReportSize(oRs.Fields("mDBOverQuotaLimit")) & ","
			End If
			
			If IsNull(oRs.Fields("mDBOverHardQuotaLimit")) Then
				sStorePolicyDictEntry = sStorePolicyDictEntry & "Unlimited,"
			Else
				sStorePolicyDictEntry = sStorePolicyDictEntry & ReportSize(oRs.Fields("mDBOverHardQuotaLimit")) & ","
			End If
			
			sStorePolicyDictEntry = sStorePolicyDictEntry & "Mailbox Store"
			If Not dicStores.Exists(sStoreNameDictEntry) Then _
				dicStores.Add sStoreNameDictEntry, sStorePolicyDictEntry
			oRs.MoveNext
		Loop
	End If
	oRs.Close(): Set oRs = Nothing
	Set oCmd = Nothing
	oConn.Close(): Set oConn = Nothing
End Sub


Sub CreateMailboxStatsReport
	On Error Resume Next
	Dim sServer, oWMIExchange, oMailboxes, oMailbox, sOutLine
	If UBound(arrServerNames) >= 0 Then
		AppendToLog "Account Name,User Principal Name,Display Name,EMail,Issue Warning,Prohibit Send,Prohibit Send and Receive,Quota Set Level,Limit Status,Mailbox Size,Total Items,Mailbox Location,LastLogonTime"
		WScript.Echo "Querying Exchange Servers For Mailboxes..."
		For Each sServer in arrServerNames
			Set oWMIExchange = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & _
								sServer & "/root/MicrosoftExchangeV2")
			If Err.Number <> 0 Then
				WScript.Echo "Unable to connect to the " & sServer & _
					"/root/MicrosoftExchangeV2 namespace."
			Else
				Set oMailboxes = oWMIExchange.ExecQuery("SELECT * FROM Exchange_Mailbox WHERE NOT LegacyDN LIKE '%SYSTEMMAILBOX%' AND NOT LegacyDN LIKE '%CN=CONFIGURATION/%'")
				If (oMailboxes.count > 0) Then
					For Each oMailbox in oMailboxes
						If oMailbox.DateDiscoveredAbsentInDS <> "" Then
							sOutLine = "[Disconnected Mailbox],N/A,N/A,N/A,N/A,N/A,N/A,N/A," & _
										LimitStatus(oMailbox.StorageLimitInfo) & "," & ReportSize(oMailbox.Size) & "," & oMailbox.TotalItems & "," & _
											oMailbox.ServerName & "\" & oMailbox.StorageGroupName &  "\" & oMailbox.StoreName & "\" & oMailbox.MailboxDisplayName &","& convertDate(oMailbox.LastLogonTime)
						Else
							sOutLine = GetMailboxStatsFromAD(oMailbox.LegacyDN) & "," & _
										LimitStatus(oMailbox.StorageLimitInfo) & "," & ReportSize(oMailbox.Size) & "," & oMailbox.TotalItems & "," & _
											oMailbox.ServerName & "\" & oMailbox.StorageGroupName &  "\" & oMailbox.StoreName & "\" & oMailbox.MailboxDisplayName &","& convertDate(oMailbox.LastLogonTime)
						End If
						AppendToLog sOutLine
	  				Next
				End If
				Set oMailbox = Nothing
				Set oMailboxes = Nothing
			End If
		Next
		Set oWMIExchange = Nothing
	Else
		WScript.Echo "No Exchange Servers found in ActiveDirectory"
	End If
End Sub


Function GetMailboxStatsFromAD(legacyExchangeDN)
	Dim sRootDSE, sQuery, sFilter, sFields, sRet, sHomeMDBCn
	Dim sSamAccountName, sUserPrincipalName, sDisplayName, sMail, sQuota
	sRootDSE = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
	Dim oConn: Set oConn = CreateObject("ADODB.Connection")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Dim oCmd: Set oCmd = CreateObject("ADODB.Command")
	oCmd.ActiveConnection = oConn
	oCmd.Properties("page size") = 15000
	sFilter = "(&(ObjectClass=user)(ObjectCategory=person)(legacyExchangeDN=" & legacyExchangeDN & "))"
	sFields = "samAccountName,userPrincipalName,displayName,mail,mDBUseDefaults,mDBStorageQuota,mDBOverQuotaLimit,mDBOverHardQuotaLimit,homeMDB"
	sQuery = "<LDAP://" & sRootDSE & ">;" & sFilter & ";" & sFields & ";subtree"
	oCmd.CommandText = sQuery
	oCmd.Properties("Page Size") = 15000
	oCmd.Properties("Timeout") = 90
	Dim oRs: Set oRs = Createobject("ADODB.Recordset")
	Set oRs = oCmd.Execute
	If oRs.RecordCount > 0 Then
		oRs.MoveFirst
		Do Until oRs.EOF
				
			If IsNull(oRs.Fields("samAccountName")) Then
				sSamAccountName = "N/A"
			Else
				sSamAccountName = oRs.Fields("samAccountName")
			End If
			
			If IsNull(oRs.Fields("userPrincipalName")) Then
				sUserPrincipalName = "N/A"
			Else
				sUserPrincipalName = oRs.Fields("userPrincipalName")
			End If
			
			If IsNull(oRs.Fields("displayName")) Then
				sDisplayName = "N/A"
			Else
				sDisplayName = Trim(oRs.Fields("displayName"))
			End If
			
			If IsNull(oRs.Fields("mail")) Then
				sMail = "N/A"
			Else
				sMail = oRs.Fields("mail")
			End If
			
			sRet = sSamAccountName & "," & sUserPrincipalName & "," & _
					sDisplayName & "," & sMail

			If Not CBool(oRs.Fields("mDBUseDefaults")) Then
				If IsNull(oRs.Fields("mDBStorageQuota")) Then
					sQuota = "Unlimited"
				Else
					sQuota = ReportSize(oRs.Fields("mDBStorageQuota"))
				End If
				
				If IsNull(oRs.Fields("mDBOverQuotaLimit")) Then
					sQuota = sQuota & "," & "Unlimited"
				Else
					sQuota = sQuota & "," & ReportSize(oRs.Fields("mDBOverQuotaLimit"))
				End If
				
				If IsNull(oRs.Fields("mDBOverHardQuotaLimit")) Then
					sQuota = sQuota & "," & "Unlimited"
				Else
					sQuota = sQuota & "," & ReportSize(oRs.Fields("mDBOverHardQuotaLimit"))
				End If
				
				sRet = sRet & "," & sQuota & ",User"
			Else
				sHomeMDBCn = GetObject("LDAP://" & oRs.Fields("homeMDB")).cn
				If dicStores.Exists(sHomeMDBCn) Then
					sRet = sRet & "," & dicStores.Item(sHomeMDBCn)
				Else
					sRet = sRet & ",UnKnown,UnKnown,UnKnown,UnKnown"
				End If
			End If
			oRs.MoveNext
		Loop
	End If
	oRs.Close(): Set oRs = Nothing
	Set oCmd = Nothing
	oConn.Close(): Set oConn = Nothing
	GetMailboxStatsFromAD = sRet
End Function


Function ReportSize(iSize)
	Dim sUnit, i: i = 0
	While iSize > 1000
		iSize = Round(((iSize)/1024),2)
		i = i + 1
	Wend
	Select Case i
		Case 0: sUnit = " KB"
		Case 1: sUnit = " MB"
		Case 2: sUnit = " GB"
		Case 3: sUnit = " TB"
		Case 4: sUnit = " PB"
	End Select
	ReportSize = iSize & sUnit
End Function


Function LimitStatus(iStatus)
	Dim sRet: sRet = "UnKnown"
	Select Case iStatus
		Case 1: sRet = "Below Limit"
		Case 2: sRet = "Issue Warning"
		Case 4: sRet = "Prohibit Send"
		Case 8: sRet = "No Checking"
		Case 16: sRet = "Mailbox Disabled"
		Case Else: sRet= "UnKnown"
	End Select
	LimitStatus = sRet
End Function
 
Function convertDate(sInputDate)
 
	sYear  	 = Left(sInputDate,4)
	sMonth 	 = Mid(sInputDate,5,2)
	sDay   	 = Mid(sInputDate,7,2)
	sHour  	 = Mid(sInputDate,9,2)
	sMin  	 = Mid(sInputDate,11,2)
	sSeconds = Mid(sInputDate,13,2)
 
	convertDate = sMonth &"/"& sDay &"/"& sYear &" "& sHour &":"& sMin &":" &sSeconds
 
End Function

Open in new window

ncomper

ASKER

ah right, is there a way of getting the last time the actual mailbox was logged onto?

We are about to do a 10'000 mailbox migration to an external email provider so im trying to get a list of the AD attributes that this script gives me plus the last time each mailbox was logged onto so we can determine if they need migrating or not.

Thanks for all your help so far.

Nick

prashanthd

The script returns the lastlogon time of mailbox only..

ncomper

ASKER

Hi Prashanthd

The last script now doesnt return any data, just the column headers where the 2 examples you gace before retuned my users, any ideas?

Many Thanks

ASKER CERTIFIED SOLUTION

prashanthd

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ncomper

ASKER

Hi

I have tried running this with my Domain admin account in our live environment and i get the error below,

T:\>cscript "C:\Documents and Settings\nicomper\Desktop\ExchangeScript.vbs"
Microsoft (R) Windows Script Host Version 5.6
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

07/11/2011 17:04:22 - Starting ExchangeScript.vbs script
Querying ActiveDirectory for Exchange Servers...
Found Exchange Server: EXCH01
Found Exchange Server: EXCH02
Found Exchange Server: EXCH03
Found Exchange Server: EXCH04
Exchange Servers found in ActiveDirectory: EXCH01,EXCH02,EXCH03,EXCH04
Querying Exchange Information Stores Quota Settings...
Querying Exchange Servers For Mailboxes...
Unable to connect to the EXCH01/root/MicrosoftExchangeV2 namespace.
Unable to connect to the EXCH02/root/MicrosoftExchangeV2 namespace.
Unable to connect to the EXCH03/root/MicrosoftExchangeV2 namespace.
Unable to connect to the EXCH04/root/MicrosoftExchangeV2 namespace.

Mailbox Statistics Report completed: C:\Documents and Settings\nicomper\Desktop\
ExchangeScript.20111107.csv
07/11/2011 17:05:13 - ExchangeScript.vbs finished!

any ideas, my test lab contains 1 DC and 1 Exchange server (all on same box) where as our live network has 1 Forest with 5 domains, the Exchange servers are across all domains

Thanks

Nick

T:\>cscript "C:\Documents and Settings\nicomper\Desktop\ExchangeScript.vbs"
Microsoft (R) Windows Script Host Version 5.6
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

07/11/2011 17:04:22 - Starting ExchangeScript.vbs script
Querying ActiveDirectory for Exchange Servers...
Found Exchange Server: EXCH01
Found Exchange Server: EXCH02
Found Exchange Server: EXCH03
Found Exchange Server: EXCH04
Exchange Servers found in ActiveDirectory: EXCH01,EXCH02,EXCH03,EXCH04
Querying Exchange Information Stores Quota Settings...
Querying Exchange Servers For Mailboxes...
Unable to connect to the EXCH01/root/MicrosoftExchangeV2 namespace.
Unable to connect to the EXCH02/root/MicrosoftExchangeV2 namespace.
Unable to connect to the EXCH03/root/MicrosoftExchangeV2 namespace.
Unable to connect to the EXCH04/root/MicrosoftExchangeV2 namespace.

Mailbox Statistics Report completed: C:\Documents and Settings\nicomper\Desktop\
ExchangeScript.20111107.csv
07/11/2011 17:05:13 - ExchangeScript.vbs finished!

T:\>

prashanthd

Sorry for late response...is the script working in test environment?

ncomper

ASKER

Hey

Sorry i midded this

Sadly i was not able to get it to work in our live network, it worked in my single Domain lab setup

Is there any issues running this in a multi domain network?

Thanks

Nick

ncomper

ASKER

Thanks, it worked in a lab but not in our live network with multiple domains.