Vista - Script to query user information based upon group membership

Hi,

I'm trying to write a script that pulls the following information based upon
the group the user is a member of:
Username
First Name, Last Name
Last Logon Date/Time

I have scripts which can tell me all of the information for all the users in
my domain, but I can't seem to figure out the code to limit my search to a
specifc group (for this example we'll call it BO). The script is based off
one by Richard Mueller for pulling user information from a domain. I've
modified it to pull only the data I needed in several cases, but in this one
I can't seem to figure out how to limit my search to the BO group.

Thank you,
Brian

Option Explicit

Dim objRootDSE, strDNSDomain, adoCommand, adoConnection, strConfig
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
Dim strDN, strNTName, strDisplayName, strGN, strFilePath
Dim strItem, strGroup, objLastLogon, dtmLastLogon
Dim lngFlags, strFlags, objPwdLastSet, dtmPwdLastSet
Dim objShell, lngBiasKey, lngTZBias, k, arrAttrValues
Dim objFSO, objFile, objDC, strwhenCreated

' Check for required arguments.
If (Wscript.Arguments.Count < 1) Then
Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
& "cscript BOA_DocumentUsers.vbs c:\MyFolder\UserList.txt"
Wscript.Quit(0)
End If

strFilePath = Wscript.Arguments(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Open the file for write access.
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "File " & strFilePath & " cannot be opened"
Set objFSO = Nothing
Wscript.Quit(1)
End If
On Error GoTo 0

' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngTZBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngTZBias = 0
For k = 0 To UBound(lngBiasKey)
lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
Next
End If
Set objShell = Nothing

' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strConfig = objRootDSE.Get("configurationNamingContext")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

strBase = "<LDAP://" & strConfig & ">"
strFilter = "(objectClass=nTDSDSA)"
strAttributes = "AdsPath"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 60
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

' Enumerate parent objects of class nTDSDSA. Save Domain Controller
' AdsPaths in dynamic array arrstrDCs.
k = 0
Do Until adoRecordset.EOF
Set objDC = _
GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
ReDim Preserve arrstrDCs(k)
arrstrDCs(k) = objDC.DNSHostName
k = k + 1
adoRecordset.MoveNext
Loop
adoRecordset.Close

' Search entire domain.
For k = 0 To Ubound(arrstrDCs)
strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
'Restrict Search to Back Office Users Only
strGN = "(primaryGroupID=" & intGroupToken & ")"
' Search for all users.
strFilter = "(&(objectCategory=person)(objectClass=user))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "sAMAccountName,displayName,lastLogon"
' Construct the LDAP query.
strQuery = strBase & ";" & strGN & ";" & strFilter & ";" & strAttributes &
";subtree"
' Run the query.
adoCommand.CommandText = strQuery
On Error Resume Next
Set adoRecordset = adoCommand.Execute
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Domain Controller not available: " & arrstrDCs(k)
Else
On Error GoTo 0

' Output heading line.
objFile.WriteLine """User Name"",""Full Name"",""Last Logon"""

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve single-valued strings.
strNTName = adoRecordset.Fields("sAMAccountName").Value
'strDisplayName = objItem.Get("displayName").Value
strDisplayName = adoRecordset.Fields("displayName").Value


' Convert Integer8 value to date in current time zone.
On Error Resume Next
Set objLastLogon = adoRecordset.Fields("lastLogon").Value
If (Err.Number <> 0) Then
On Error GoTo 0
dtmLastLogon = #1/1/1601#
Else

On Error GoTo 0
dtmLastLogon = Integer8Date(objLastLogon, lngTZBias)
End If

' Create array of string values to display.
arrAttrValues = Array(strNTName, strDisplayName, CStr(dtmLastLogon))

' Display array of values in a comma delimited line, with each
' value enclosed in quotes.
'Wscript.Echo CSVLine(arrAttrValues)
objFile.WriteLine CSVLine(arrAttrValues)

' Move to next record in recordset.
adoRecordset.MoveNext
Loop

' Clean up.
adoRecordset.Close
adoConnection.Close
End If
Next


Function Integer8Date(ByVal objDate, ByVal lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngAdjust, lngDate, lngHigh, lngLow
lngAdjust = lngBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart
' Account for error in IADslargeInteger property methods.
If (lngLow < 0) Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
lngAdjust = 0
End If
lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow) / 600000000 - lngAdjust) / 1440
' Trap error if lngDate is ridiculously huge.
On Error Resume Next
Integer8Date = CDate(lngDate)
If (Err.Number <> 0) Then
On Error GoTo 0
Integer8Date = #1/1/1601#
End If
On Error GoTo 0
End Function

Function CSVLine(ByVal arrValues)
' Function to convert array of values into comma delimited
' values enclosed in quotes.
Dim strItem

CSVLine = ""
For Each strItem In arrValues
' Replace any embedded quotes with two quotes.
If (strItem <> "") Then
strItem = Replace(strItem, """", """" & """")
End If
' Append string values, enclosed in quotes,
' delimited by commas.
If (CSVLine = "") Then
CSVLine = """" & strItem & """"
Else
CSVLine = CSVLine & ",""" & strItem & """"
End If
Next

End Function

Wscript.Echo "Done"


--
Brian Moffitt, MCSE 2003

Hi Brian,

Here is an alternative script that fetches the employees and AD
attributes for users in a particular OU.

This script is different than the script you and Richard are working
on ...

Once you get tens of thousands of members in an OU eventually you'll
end up adding an
"On Error Resume Next" statement to the top of the source.

This occurs because somewhere you end up with a few problematic record
having outlier data types - or you might end up adding a lot of logic
and for some reason checking for null values (Nothing) doesn't work
for some particular record.

It can take an hour to enumerate through a domain of 20 thousand users
- so sorting out the problematic records is time consuming - and even
if they are sorted out there are no guarantees that new problematic
records are added.

With a "On Error Resume Next" statement you can end up incorrect
results - because the recordset from the previous iteration can become
associated with the current iteration: or even the next several
iterations.

This alternative script creates a new user defined class: User, on
each iteration that gets around the problem of residual data from the
previous iteration. With this script you can add a resume statement
and not have to worry about incorrect results.

Another difference, comparing scripts, is that this script fetches the
members of the OU using OU syntax instead of AD query syntax. My
experience is that this approach is more robust.


Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_UF_PASSWD_CANT_CHANGE = &H0040
Const DARK_BLUE = 47
Const LIGHT_BLUE = 37

Dim i,objws,objXL,objwb,ObjDomain


Include "User.bas"

Set ObjRoot = GetObject("LDAP://RootDSE")
strDNC = ObjRoot.Get("DefaultNamingContext")
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True

Set ObjDomain = GetObject("LDAP://dc=eu,dc=msds,dc=mycompany,dc=com")

Sub Main()
ExcelSetUp()
i = 2
Call enummembers(ObjDomain)
ExcelWrapUp()
MsgBox "Done"
End Sub

Sub enumMembers(ObjDomain)
For Each ObjMember In ObjDomain
If objMember.Class = "organizationalUnit" or OBjMember.Class =
"container" Then
enumMembers (objMember)
End If
If ((ObjMember.Class = "user") or (objmember.Class = "person")) Then
If "Enabled" = getEnabled(ObjMember) Then
Set usr = New User
usr.employeeID = getEmployeeID(ObjMember)
usr.displayName = getDisplayName(ObjMember)
usr.sAMAccountName = getsAMAccountName(ObjMember)
usr.whenCreated = getWhenCreated(ObjMember)
usr.AdsPath = getAdsPath(ObjMember)
usr.lastLogonTimeStamp =
getTimeStamp(ObjMember,"lastLogonTimeStamp")
usr.passwordExpires = getPasswordExpires(ObjMember)
usr.passwordChanges = getPasswordChanges(ObjMember)
usr.title = getTitle(ObjMember)
usr.manager = getManager(ObjMember)
usr.canonicalName = getCanonicalName(ObjMember)
usr.userAccountControl = getUserAccountControl(ObjMember)
usr.extensionAttribute1 = getExtensionAttribute1(ObjMember)
usr.sinceCreatedDays = getSinceCreatedDays(ObjMember)
usr.description = getDescription(ObjMember)
usr.accountExpirationDate = getAccountExpirationDate(ObjMember)
TouchUp(usr)
ExcelInsertRow i,usr
i = i + 1
set usr = Nothing
End If
End If
Set objMember = Nothing
Next
End Sub

Public Function getDisplayName(ObjMember)
On Error Resume Next
DisplayName = "-"
DisplayName = ObjMember.displayName
getDisplayName = DisplayName
End Function

Public Function getsAMAccountName(ObjMember)
On Error Resume Next
sAMAccountName = "-"
sAMAccountName = ObjMember.sAMAccountName
getsAMAccountName = sAMAccountName
End Function

Public Function getEmployeeID(ObjMember)
On Error Resume Next
EmployeeID = "-"
Set ObjEmployeeID = Nothing
ObjEmployeeID = ObjMember.getEx("employeeID")
EmployeeID = ObjEmployeeID(0)
getEmployeeID = EmployeeID
End Function

Public Function getEnabled(ObjMember)
On Error Resume Next
Enabled = "Enabled"
If not ((ObjMember.UserAccountControl = "512") Or
(objmember.UserAccountControl = "66048")) Then
Enabled = "Disabled"
End If
getEnabled = Enabled
End Function

Public Function getCanonicalName(ObjMember)
On Error Resume Next
ObjMember.GetInfoEx Array("canonicalName"),0
Set ObjCanonicalName = Nothing
ObjCanonicalName = ObjMember.getEx("canonicalName")
CanonicalName = "-"
CanonicalName = ObjCanonicalName(0)
getCanonicalName = CanonicalName
End Function

Public Function getWhenCreated(ObjMember)
On Error Resume Next
WhenCreated = "-"
WhenCreated = ObjMember.whenCreated
getWhenCreated = WhenCreated
End Function

Public Function getAdsPath(ObjMember)
On Error Resume Next
AdsPath = "-"
AdsPath = ObjMember.AdsPath
getAdsPath = AdsPath
End Function

Public Function getTimeStamp(ObjMember,attribute)
On Error Resume Next
Set LastLogin = Nothing
Set LastLogin = objMember.get(attribute)
If LastLogin.HighPart = "" Then
intLLTS = "Never"
Else
intLogonTime = LastLogin.Highpart * (2^32) + LastLogin.LowPart
IntLogonTime = IntLogonTime / (60 * 10000000)
intLogonTime = intLogonTime / 1440
If intLogonTime = 0 Then
intLLTS = "Never"
Elseif intLogonTime = "" Then
intLLTS = "Never"
Else
intLLTS = intLogonTime + #1/1/1601#
End If
End If
getTimeStamp = intLLTS
End Function

Public Function getPasswordExpires(ObjMember)
On Error Resume Next
Set UserAccountControl = Nothing
UserAccountControl = ObjMember.userAccountControl
PasswordExpires = "-"
If UserAccountControl AND ADS_UF_DONT_EXPIRE_PASSWD Then
PasswordExpires = "CanNotExpire"
Else
PasswordExpires = "Expires"
End If
getPasswordExpires = PasswordExpires
End Function

Public Function getPasswordChanges(ObjMember)
On Error Resume Next
PasswordChanges = "-"
If ( objMember.getFlags("userFlags") And ADS_UF_PASSWD_CANT_CHANGE )
Then
PasswordChanges = "CanNotChange"
Else
PasswordChanges = "CanChange"
End If
getPasswordChanges = PasswordChanges
End Function

Public Function getTitle(ObjMember)
On Error Resume Next
Title = "-"
Title = ObjMember.Title
getTitle = Title
End Function

Public Function getManager(ObjMember)
On Error Resume Next
Manager = "-"
Manager = ObjMember.Manager
getManager = Manager
End Function

Public Function getExtensionAttribute1(ObjMember)
On Error Resume Next
ExtensionAttribute1 = "-"
ExtensionAttribute1 = ObjMember.ExtensionAttribute1
getExtensionAttribute1 = ExtensionAttribute1
End Function

Public Function getUserAccountControl(ObjMember)
On Error Resume Next
Set UserAccountControl = Nothing
UserAccountControl = ObjMember.userAccountControl
getUserAccountControl = UserAccountControl
End Function

Public Function getSinceCreatedDays(ObjMember)
On Error Resume Next
SinceCreatedDays = date - int(cdate(ObjMember.whenCreated))
getSinceCreatedDays = SinceCreatedDays
End Function

Public Function getDescription(ObjMember)
On Error Resume Next
Description = "-"
Description = ObjMember.description
getDescription = Description
End Function

Public Function getAccountExpirationDate(ObjMember)
On Error Resume Next
AccountExpirationDate = ""
If isNull(ObjMember.AccountExpirationDate) or
ObjMember.AccountExpirationDate = "1/1/1970" Then
AccountExpirationDate = "Null"
Else
AccountExpirationDate = ObjMember.AccountExpirationDate
End If
getAccountExpirationDate = AccountExpirationDate
End Function

Function DoFilter(objMember)
DFilter = true
If Not ((ObjMember.Class = "user") or (objmember.Class = "person"))
Then
DFilter = false
ElseIf "Enabled" <> getEnabled(ObjMember) Then
DFilter = false
End If
DoFilter = DFilter
End Function

Sub ExcelSetUp()
objXL.StatusBar = "Fetching data from Active Directory"
objXL.DisplayAlerts = false
Set objwb = objXL.Workbooks.Add
Set objws = ExcelAddSheet("ActiveDirectory",DARK_BLUE)
For each sheet in objwb.Sheets
if "ActiveDirectory" <> sheet.name Then
sheet.Activate
sheet.Delete
End If
Next
data = Array ( "employeeID", _
"displayName", _
"sAMAccountName", _
"whenCreated", _
"AdsPath", _
"lastLogonTimeStamp", _
"passwordExpires", _
"passwordChanges", _
"title", _
"Manager", _
"canonicalName", _
"userAccountControl", _
"extensionAttribute1", _
"sinceCreatedDays", _
"description", _
"accountExpirationDate")
objws.Range(objws.Cells(1,1),objws.Cells(1,16)).Value = data
Set o = ExcelAddSheet("People", DARK_BLUE)
Set o = ExcelAddSheet("Matches", DARK_BLUE)
Set o = ExcelAddSheet("UnMatches", DARK_BLUE)
Set o = ExcelAddSheet("AA_Accounts", LIGHT_BLUE)
Set o = ExcelAddSheet("OK_Accounts", LIGHT_BLUE)
Set o = ExcelAddSheet("AD_Templates", LIGHT_BLUE)
Set o = ExcelAddSheet("iShare_Accounts", LIGHT_BLUE)
Set o = ExcelAddSheet("SystemGeneric_Accounts", LIGHT_BLUE)
Set o = ExcelAddSheet("Vendor_Accounts", LIGHT_BLUE)
Set o = ExcelAddSheet("QA_Accounts", LIGHT_BLUE)
Set o = ExcelAddSheet("SPS_Accounts", LIGHT_BLUE)
Set o = ExcelAddSheet("Temporary_Accounts", LIGHT_BLUE)
Set o = ExcelAddSheet("Supplemental_Accounts", LIGHT_BLUE)
objws.Activate
End Sub

Public Function ExcelAddSheet(Name,Color)
Set ws = objwb.Sheets.Add
ws.Name = Name
ws.Tab.ColorIndex = Color
Set ExcelAddSheet = ws
End Function

Sub ExcelInsertRow(i,usr)
On Error Resume Next
data = Array ( usr.employeeID, _
usr.displayName, _
usr.sAMAccountName, _
usr.whenCreated, _
usr.adsPath, _
usr.lastLogonTimeStamp, _
usr.passwordExpires, _
usr.passwordChanges, _
usr.title, _
usr.manager, _
usr.canonicalName, _
usr.userAccountControl, _
usr.extensionAttribute1, _
usr.sinceCreatedDays, _
usr.description, _
usr.accountExpirationDate)
objws.Range(objws.Cells(i,1),objws.Cells(i,16)).Value = data
End Sub

Sub ExcelWrapUp()
Set oVBC = objwb.VBProject.VBComponents
Set M = oVBC.Import(GetPath() & "\Compare.bas")
Set M = oVBC.Import(GetPath() & "\Filter.bas")
Set M = oVBC.Import(GetPath() & "\OpenFiles.bas")
M.CodeModule.AddFromString "Public Const HR_FILE_CORP = " & chr(34) &
HR_FILE_CORP & chr(34) & chr(10)
M.CodeModule.AddFromString "Public Const HR_FILE_PROT = " & chr(34) &
HR_FILE_PROT & chr(34) & chr(10)
Set M = oVBC.Import(GetPath() & "\Run.bas")
Set M = oVBC.Import(GetPath() & "\SetUpData.bas")
Set M = oVBC.Import(GetPath() & "\Utils.bas")
objwb.Application.Run "Run.Run"
End Sub

Sub TouchUp(usr)
If "-" = usr.employeeID Then
usr.employeeID = usr.extensionAttribute1
End If
If "" = usr.employeeID Then
usr.employeeID = "-"
End If
If " "= usr.employeeID Then
usr.employeeID = "-"
End If
End Sub

-----

Class User
Private m_sAMAccountName
Public Property Let sAMAccountName(p_sAMAccountName)
m_sAMAccountName = p_sAMAccountName
end Property

Public Property Get sAMAccountName()
sAMAccountName = m_sAMAccountName
End Property

Private m_employeeID
Public Property Let employeeID(p_employeeID)
m_employeeID = p_employeeID
end Property

Public Property Get employeeID()
employeeID = m_employeeID
End Property

Private m_canonicalName
Public Property Let canonicalName(p_canonicalName)
m_canonicalName = p_canonicalName
end Property

Public Property Get canonicalName()
canonicalName = m_canonicalName
End Property

Private m_displayName
Public Property Let displayName(p_displayName)
m_displayName = p_displayName
end Property

Public Property Get displayName()
displayName = m_displayName
End Property

Private m_whenCreated
Public Property Let whenCreated(p_whenCreated)
m_whenCreated = p_whenCreated
end Property

Public Property Get whenCreated()
whenCreated = m_whenCreated
End Property

Private m_AdsPath
Public Property Let AdsPath(p_AdsPath)
m_AdsPath = p_AdsPath
end Property

Public Property Get AdsPath()
AdsPath = m_AdsPath
End Property

Private m_lastLogonTimeStamp
Public Property Let lastLogonTimeStamp(p_lastLogonTimeStamp)
m_lastLogonTimeStamp = p_lastLogonTimeStamp
end Property

Public Property Get lastLogonTimeStamp()
lastLogonTimeStamp = m_lastLogonTimeStamp
End Property

Private m_passwordExpires
Public Property Let passwordExpires(p_passwordExpires)
m_passwordExpires = p_passwordExpires
end Property

Public Property Get passwordExpires()
passwordExpires = m_passwordExpires
End Property

Private m_passwordChanges
Public Property Let passwordChanges(p_passwordChanges)
m_passwordChanges = p_passwordChanges
end Property

Public Property Get passwordChanges()
passwordChanges = m_passwordChanges
End Property

Private m_title
Public Property Let title(p_title)
m_title = p_title
end Property

Public Property Get title()
title = m_title
End Property

Private m_manager
Public Property Let manager(p_manager)
m_manager = p_manager
end Property

Public Property Get manager()
manager = m_manager
End Property

Private m_userAccountControl
Public Property Let userAccountControl(p_userAccountControl)
m_userAccountControl = p_userAccountControl
end Property

Public Property Get userAccountControl()
userAccountControl = m_userAccountControl
End Property

Private m_lastLogonDays
Public Property Let lastLogonDays(p_lastLogonDays)
m_lastLogonDays = p_lastLogonDays
end Property

Public Property Get lastLogonDays()
lastLogonDays = m_lastLogonDays
End Property

Private m_extensionAttribute1
Public Property Let extensionAttribute1(p_extensionAttribute1)
m_extensionAttribute1 = p_extensionAttribute1
end Property

Public Property Get extensionAttribute1()
extensionAttribute1 = m_extensionAttribute1
End Property

Private m_sinceCreatedDays
Public Property Let sinceCreatedDays(p_sinceCreatedDays)
m_sinceCreatedDays = p_sinceCreatedDays
end Property

Public Property Get sinceCreatedDays()
sinceCreatedDays = m_sinceCreatedDays
End Property

Private m_description
Public Property Let description(p_description)
m_description = p_description
end Property

Public Property Get description()
description = m_description
End Property

Private m_accountExpirationDate
Public Property Let accountExpirationDate(p_accountExpirationDate)
m_accountExpirationDate = p_accountExpirationDate
End Property

Public Property Get accountExpirationDate()
accountExpirationDate = m_accountExpirationDate
End Property

End Class

That is deffinately an interesting script, but at least in my case it really
doesn't get me anything the script Richard and I came up with. In my case
I'm dealing with less than 5,000 users total in the domain. In the
particular group I'm querying there are only 50 users so I do not really have
need of an extremely robust script.
Below is the final script which I'm now using in production.

Thank you again for your answer to my question. I've saved the script
provided off should I ever have need of such a well written and useful script.

Brian

' Document_Users_By_Group.vbs
' VBScript program to document all users in a specified Active Directory
group.
' Creates a comma delimited file which can be read into a
' spreadsheet program.
'
' ----------------------------------------------------------------------
' Original Source Code
' Copyright (c) 2007 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - August 6, 2007
'
' Modified Code
' Copyright (c) 2008 Brian E. Moffitt
' Version 1.0 - November 4, 2008
' Version 1.1 - November 5, 2008 - Code Clean-up to remove unecessary lines
'
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.
'


Option Explicit

Dim objRootDSE, strDNSDomain, adoCommand, adoConnection, strConfig
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
Dim strDN, strNTName, strDisplayName, strFilePath
Dim strItem, strNetBIOSDomain, strGroupDN
Dim objLastLogon, dtmLastLogon, objTrans
Dim objShell, lngBiasKey, lngTZBias, k, arrAttrValues
Dim objFSO, objFile, objDC

' Check for required arguments.
If (Wscript.Arguments.Count < 1) Then
Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
& "cscript Document_Users_By_Group.vbs c:\MyFolder\UserList.txt"
Wscript.Quit(0)
End If

strFilePath = Wscript.Arguments(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Open the file for write access.
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "File " & strFilePath & " cannot be opened"
Set objFSO = Nothing
Wscript.Quit(1)
End If
On Error GoTo 0

' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngTZBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngTZBias = 0
For k = 0 To UBound(lngBiasKey)
lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
Next
End If
Set objShell = Nothing

' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strConfig = objRootDSE.Get("configurationNamingContext")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

strBase = "<LDAP://" & strConfig & ">"
strFilter = "(objectClass=nTDSDSA)"
strAttributes = "AdsPath"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 60
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

' Enumerate parent objects of class nTDSDSA. Save Domain Controller
' AdsPaths in dynamic array arrstrDCs.
k = 0
Do Until adoRecordset.EOF
Set objDC = _
GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
ReDim Preserve arrstrDCs(k)
arrstrDCs(k) = objDC.DNSHostName
k = k + 1
adoRecordset.MoveNext
Loop
adoRecordset.Close

' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

' Use the NameTranslate object to find the NetBIOS domain name from the
' DNS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)

' Prompt for NetBIOS name of group.
strNTName = InputBox("Enter NetBIOS name of group")

' Use the Set method to specify the NT format of the object name.
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strNTName
' Use the Get method to retrieve the RPC 1779 Distinguished Name.
strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)

' Search entire domain.
For k = 0 To Ubound(arrstrDCs)
strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
' Search for all users in the specified group.
strFilter = "(&(objectCategory=person)(objectClass=user)" _
& "(memberOf=" & strGroupDN & "))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "sAMAccountName,displayName,lastLogon"
' Construct the LDAP query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
' Run the query.
adoCommand.CommandText = strQuery
On Error Resume Next
Set adoRecordset = adoCommand.Execute
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Domain Controller not available: " & arrstrDCs(k)
Else
On Error GoTo 0

' Output heading line.
objFile.WriteLine """User Name"",""Full Name"",""Last Logon"""

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve single-valued strings.
strNTName = adoRecordset.Fields("sAMAccountName").Value
'strDisplayName = objItem.Get("displayName").Value
strDisplayName = adoRecordset.Fields("displayName").Value


' Convert Integer8 value to date in current time zone.
On Error Resume Next
Set objLastLogon = adoRecordset.Fields("lastLogon").Value
If (Err.Number <> 0) Then
On Error GoTo 0
dtmLastLogon = #1/1/1601#
Else

On Error GoTo 0
dtmLastLogon = Integer8Date(objLastLogon, lngTZBias)
End If

' Create array of string values to display.
arrAttrValues = Array(strNTName, strDisplayName, CStr(dtmLastLogon))

' Display array of values in a comma delimited line, with each
' value enclosed in quotes.
'Wscript.Echo CSVLine(arrAttrValues)
objFile.WriteLine CSVLine(arrAttrValues)

' Move to next record in recordset.
adoRecordset.MoveNext
Loop

' Clean up.
adoRecordset.Close
adoConnection.Close
End If
Next


Function Integer8Date(ByVal objDate, ByVal lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngAdjust, lngDate, lngHigh, lngLow
lngAdjust = lngBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart
' Account for error in IADslargeInteger property methods.
If (lngLow < 0) Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
lngAdjust = 0
End If
lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow) / 600000000 - lngAdjust) / 1440
' Trap error if lngDate is ridiculously huge.
On Error Resume Next
Integer8Date = CDate(lngDate)
If (Err.Number <> 0) Then
On Error GoTo 0
Integer8Date = #1/1/1601#
End If
On Error GoTo 0
End Function

Function CSVLine(ByVal arrValues)
' Function to convert array of values into comma delimited
' values enclosed in quotes.
Dim strItem

CSVLine = ""
For Each strItem In arrValues
' Replace any embedded quotes with two quotes.
If (strItem <> "") Then
strItem = Replace(strItem, """", """" & """")
End If
' Append string values, enclosed in quotes,
' delimited by commas.
If (CSVLine = "") Then
CSVLine = """" & strItem & """"
Else
CSVLine = CSVLine & ",""" & strItem & """"
End If
Next

End Function

Wscript.Echo "Done"

--
Brian Moffitt, MCSE 2003


"gimme_this_gimme_that@xxxxxx" wrote: