'Alan Kaplan 
'Get email info for user
'This is dependent on local path structure, your mileage may vary.
'1/5/08

Option Explicit
'On Error Resume Next
dim wshShell, strSamAccount
Dim oConn, oCom, oRoot, sDomain
Dim StrMessage, oRS, strMail, retval

Set wshShell = WScript.CreateObject("WScript.Shell")
strSamAccount = ucase(wshShell.ExpandEnvironmentStrings("%UserName%"))
strSamAccount = InputBox("This gets email address, server, storage group and database.  Enter the users NT Name","NT Name",strSamAccount)

If strSAMAccount = "" Then WScript.Quit

strSAMAccount = ucase(strSAMAccount)


'Note we are not getting domain info.  The NT 4 name should be unique.

Const ADS_SCOPE_SUBTREE = 2

Set oConn = CreateObject("ADODB.Connection")
Set oCom = CreateObject("ADODB.Command")
oConn.Provider = ("ADsDSOObject")
oConn.Open "Active Directory Provider"
oCom.ActiveConnection = oConn
'Get the ADsPath for the domain to search. 
Set oRoot = GetObject("LDAP://rootDSE")
sDomain = ORoot.Get("defaultNamingContext")

'Asking the Global Catalog...
oCom.CommandText = "SELECT mail, Homemdb, msExchHomeServerName,  displayName, samAccountName FROM " & _
    "'GC://"&sdomain &"' WHERE samAccountName = '" & strSamAccount &"'"
oCom.Properties("SearchScope") = ADS_SCOPE_SUBTREE
Set oRS = oCom.Execute
If oRS.RecordCount = 0 Then
    MsgBox "User Not found",vbCritical + vbOKOnly,"Lookup Failed"
	WScript.Quit
End If 

If Not IsNull(oRS("mail").value) Then 
	strMail = oRS("mail").value
Else
	strMail = "(No Address found)"
End If 

strMessage = "Display Name: " & oRS("DisplayName").value  & VbCrLf & _
			"Email address: " & strMail & VbCrLf & _
			"Exchange Server: " & ServerName(oRS("msExchHomeServerName")) & VbCrLf & _
			mdbInfo(oRS("HomeMDB"))

retval = MsgBox(strmessage& VbCrLf & VbCrLf & "Dump to file on your desktop?",vbInformation + vbYesNo+vbDefaultbutton2, strSamAccount & " Email Info")
If retval = vbYes Then 
	dim fso,logfile, oFWrite
	logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\" & strSamAccount & ".txt"
	'setup log
	set fso = CreateObject("Scripting.FileSystemObject")
	set oFWrite = fso.CreateTextFile(logfile, True)
	oFWrite.write StrMessage
	wshShell.Popup strSamAccount & ".txt written to your desktop.",5,"File Written"
End If 

Function ServerName(strPath)
	Dim aTemp
	strPath = strPath.Value
	aTemp = Split(strPath,"=")
	ServerName = aTemp(UBound(aTemp))
End Function 

Function MDBInfo(strPath)
	Dim aTemp
	strPath = strPath.Value
	aTemp = Split(strPath,",")
	MDBInfo = "Database: " & Replace(aTemp(0),"CN=","") & VbCrLf  & _
	"Storage Group: " & Replace(aTemp(1),"CN=","")
End Function