active directory question

With the help of this newsgroup I have a script that will pull the the groups
off a specified folder output them and the members of each group to separate
sheets in an excel spreadsheet. I also want to output the logon names of each
member. To do this I have to access the User properties instead of the Group.

The format of the name in the spread*** is smith,john - which is the
display name in active directory. Can i reference this name from the
spread*** and query AD to output the logon name of each user? This location
is referenced in the script by this - objExcel.WorkSheets(w).cells(y,1).value

I don't know how to put this back into an AD query to pull logon names for
the user display name that is in that location - also has to loop through
becasue i don't know how many users will be in each group.

Any help is appreciated - script is copied below.

Dim objCommand, objConnection, strBase, strFilter, strAttributes
Dim strQuery, objRecordset, strName, strCN
Dim excelgroups, objExcel, objWshNet, strFoldername, UNCPathName, DrvLetter,
strComputerName
Set objExcel = CreateObject("Excel.Application")
On Error resume Next

objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Cells(2, 1).Value = "Login\Group Name"
objExcel.Cells(2, 1).Font.Bold = True
objExcel.Cells(2, 2).Value = "Access Allowed\Denied"
objExcel.Cells(2, 2).Font.Bold = TRUE
objExcel.Cells(2, 3).Value = "Permission Assigned"
objExcel.Cells(2, 3).Font.Bold = TRUE
objExcel.WorkSheets(1).name = "Permissions List"


UNCPathName = InputBox("please supply the UNC path to the shared folder")
DrvLetter = InputBox("Please supply unused driver letter followed by a colon")

set objWshNet = WScript.CreateObject("Wscript.Network")
objWshNet.MapNetworkDrive DrvLetter, UNCPathName

If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Number & vbcrlf &_
Err.Description & " 0"
End If


If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Number & vbcrlf &_
Err.Description & " 1"
End If
objExcel.Cells(1, 1).Value = UNCPathName
objExcel.Cells(1, 1).Font.Bold = TRUE
SE_DACL_PRESENT = &h4
ACCESS_ALLOWED_ACE_TYPE = &h0
ACCESS_DENIED_ACE_TYPE = &h1
If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Number & vbcrlf &_
Err.Description & " 2"
End If

Set objWMIService = GetObject("winmgmts:")

If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Number & vbcrlf &_
Err.Description & " 3"
End If

Set objFolderSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting.path='" & DrvLetter &
"\'")

If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Number & vbcrlf &_
Err.Description & " 4"
End If
intRetVal = objFolderSecuritySettings.GetSecurityDescriptor(objSD)

If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Number & vbcrlf &_
Err.Description & " 5"
End If

intControlFlags = objSD.ControlFlags

If intControlFlags AND SE_DACL_PRESENT Then

arrACEs = objSD.DACL
X=3
For Each objACE in arrACEs

objExcel.Cells(x, 1).Value = _
objACE.Trustee.Domain & "\" & objACE.Trustee.Name
If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then
objExcel.Cells(x, 2).Value = _
vbTab & "Allowed:"
ElseIf objACE.AceType = ACCESS_DENIED_ACE_TYPE Then
objExcel.Cells(x, 2).Value = _
vbTab & "Denied:"
End If
If objACE.AccessMask = "1245631" Then
objExcel.Cells(x, 3).Value = "Modify"
End If
If objACE.AccessMask = "1179785" Then
objExcel.Cells(x, 3).Value = "Read Only"
End If
If objACE.AccessMask = "1179817" Then
objExcel.Cells(x, 3).Value = "Read & Execute"
End If
If objACE.AccessMask = "2032127" Then
objExcel.Cells(x, 3).Value = "Full Control"
End If



X=X+1

Next
Else
WScript.Echo "No DACL present in security descriptor"
End If

Set objRange = objExcel.Range("A1")
objRange.Activate

Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()


Set objRange = objExcel.Range("A1").SpecialCells(11)
Set objRange2 = objExcel.Range("C1")
Set objRange3 = objExcel.Range("A1")

x=2
Do Until objExcel.Cells(x,1).Value = ""
arrSecCon= Split(objExcel.Cells(x,1).Value, "\")
CellValue=arrSecCon(1)
objExcel.Cells(x,1).Value=CellValue
x=x+1
loop

w=2
x=2

Do Until objExcel.Worksheets(1).Cells(x,1).Value = ""



Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://dc=test,dc=test1,dc=com>"
strFilter = "(&(objectCategory=group)(cn=" &
objExcel.Worksheets(1).Cells(x,1).Value & "))"
strAttributes = "sAMAccountName,cn,member,objectClass"
strQuery = strBase & ";" & strFilter & ";" & strAttributes &
";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
objExcel.Worksheets(1).cells(x,
2).value=objRecordSet.Fields("objectCategory").Value
If objRecordSet.Fields("objectClass").Value = "Top;group" Then
Do Until objRecordSet.EOF

MbrName = objRecordSet.Fields("sAMAccountName").Value
Wscript.echo "Beginning of enumeration of group " & MbrName
y=2
arrUsers = objRecordSet.Fields("member").Value

If IsNull(arrUsers) Then
Wscript.Echo "-- No users assigned to group"
Else

If w>=4 Then

objExcel.worksheets.Add

objExcel.WorkSheets(w).move objExcel.WorkSheets(w-1)

End If
objExcel.WorkSheets(w).Activate
objExcel.Cells(1, 1).Font.Bold = TRUE
objExcel.WorkSheets(w).Cells(1, 1).Value = MbrName

Set objRange = objExcel.Range("A1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

For Each strUser In arrUsers

'Get the position of "OU="
OU_pos = Instr(strUser, "OU=")
strUser1 = strUser


If objRecordSet.Fields("objectClass").Value = "Top;group" Then

'objExcel.WorkSheets(w).cells(y,1).value=strUser

'Lets get only the info we are interested in
'Starting at position 4 and up to the location of "OU"

strUser1 = Replace(strUser1, "\", "")
objExcel.WorkSheets(w).cells(y,1).value=Mid(strUser1, 4,
OU_pos - 5)


y=y+1
End If
Next

End If
objRecordSet.MoveNext

objExcel.WorkSheets(w).name = MbrName

w=W+1
Loop
End IF



x=x+1


loop

objWshNet.removenetworkdrive DrvLetter, True, True
objConnection.Close

wscript.quit

.