Login  | |
|
 |
RE: Export Active Directory Users to Excel Worksheet - 5/30/2006 12:56:04 AM
|
|
 |
|
| |
gdewrance
Posts: 586
Score: 3
Joined: 3/16/2006
Status: offline
|
here is another one
'==========================================================================
'
' NAME: GetGroupMembers.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: http://www.thespidersparlor.com
' DATE : 3/23/2005
'
' COMMENT: This script and many more are available in
' the Admin Script Pack by The Spider's Parlor
'==========================================================================
Dim sResultText,Grps,MemberList
Dim oRootDSE, oConnection, oCommand, oRecordSet
Set oRootDSE = GetObject("LDAP://rootDSE")
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = oConnection
ldstring = "<LDAP://" & oRootDSE.get("defaultNamingContext") & ">;"
objCommand.CommandText=ldstring & "(objectClass=group);name,SamAccountName"
Set oRecordSet = objCommand.Execute()
Do While Not oRecordSet.EOF
sResultText = sResultText & oRecordSet.Fields("samAccountName") & vbCrLf
'WScript.Echo oRecordSet.Fields("samAccountName") & vbCrLf
MemberList=RetrieveUsers(dom,oRecordSet.Fields("samAccountName"))
'WScript.Echo Memberlist
sResultText = sResultText & memberlist & vbCrLf & "************************************" & vbCrLf
oRecordSet.MoveNext
Loop
'Wscript.Echo sResultText
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile (dom & "DomainGroupUsers.txt", ForWriting)
ts.write sResultText
MsgBox "Done"
'*****************************************************************************************
'*****************************************************************************************
Function RetrieveUsers(domainName,grpName)
dim dom
dim grp
dim GrpObj
dim mbrlist
dim mbr
'-------------------------------------------------------------------------------
' *** Enumerate Group Members ***
'-------------------------------------------------------------------------------
grp = grpName
Set objDomain = getObject("LDAP://rootDse")
domainName = objDomain.Get("dnsHostName")
' Build the ADSI query and retrieve the group object
Set GrpObj = GetObject("WinNT://" & domainName & "/" & grp & ",group")
' Loop through the group membership and build a string containing the names
for each mbr in GrpObj.Members
On error resume next
mbremail = SearchEmail(mbr.name)
If Err Then
mbrlist = mbrlist & vbTab & mbr.name & vbCrLf
Else
'if you don't want the email addresses, then copy the line 2 up to below
mbrlist = mbrlist & vbTab & mbr.name & vbTab & vbTab & mbremail+ vbCrLf
End If
Next
'The next line returns mbrlist back up to the main body
RetrieveUsers=mbrlist
End Function
Public Function SearchEmail(ByVal vSAN)
' Function: SearchDistinguishedName
' Description: Searches the DistinguishedName for a given SamAccountName
' Parameters: ByVal vSAN - The SamAccountName to search
' Returns: The DistinguishedName Name
Dim oRootDSE, oConnection, oCommand, oRecordSet
Set oRootDSE = GetObject("LDAP://rootDSE")
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Open "Provider=ADsDSOObject;"
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection
oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & _
">;(&(objectCategory=User)(samAccountName=" & vSAN & "));mail;subtree"
Set oRecordSet = oCommand.Execute
On Error Resume Next
SearchEmail = oRecordSet.Fields("mail")
On Error GoTo 0
oConnection.Close
Set oRecordSet = Nothing
Set oCommand = Nothing
Set oConnection = Nothing
Set oRootDSE = Nothing
End Function
|
|
| |
|
|
|
|
RE: Export Active Directory Users to Excel Worksheet - 6/2/2006 5:39:06 AM
|
|
|
|
| |
tcole33
Posts: 6
Score: 0
Joined: 5/26/2006
Status: offline
|
Just wanted you to know that this script rocks. Can't thank you enough for it.... I was wondering if I could possibly pick your brain and ask if there is a way to write this information back to active directory from the access database? I guess what I'm wondering is that I am also in the middle of building a test lab. I have imported all of the users, ous, and groups into my test lab but using ldifde I am not able to import the group memberships with the groups. I was wondering if this could actually push everything to my test lab from the database......make sense? The code I am using is below to build the access database (your script modified to my env.). Thanks.
Dim conn, dbpath, sqlcommand, dbTableName
Dim UserName, Department, CN
Dim ObjMember, ObjGroup, strGroupName, strActiveGroup, ObjGroupMember
Dim strDN, objMemberList
Dim objConnection, objCommand, objRootDSE, strDNSDomain
' Dictionary object to track group membership.
Set objMemberList = CreateObject("Scripting.Dictionary")
objMemberList.CompareMode = vbTextCompare
'######################################
dbPath = "C:\Scripts\MUG\Access\tblgroupsDb.mdb"
'######################################
dbTableName = "tblGroups"
Set conn = CreateObject("ADODB.Connection")
conn.Provider="Microsoft.Jet.OLEDB.4.0"
conn.Open dbpath
SqlCommand = "DELETE * FROM [" & dbTableName & "]"
conn.Execute (SqlCommand)
Set objRoot = GetObject("LDAP://RootDSE")
strDNC = objRoot.Get("DefaultNamingContext")
strDNSDomain = objRoot.Get("defaultNamingContext")
Set objOU = GetObject("LDAP://" & strDNC)
' Setup ADO.
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 10000
objCommand.Properties("Timeout") = 99
objCommand.Properties("Cache Results") = False
Call enummembers(objOU)
Sub enumMembers(ActiveObjectOU)
For Each objGroupMember In ActiveObjectOU
If objGroupMember.Class = "group" Then
Call EnumGroup(ObjGroupMember)
End If
If objGroupMember.Class = "organizationalUnit" or objGroupMember.Class = "container" Then
enumMembers (ObjGroupMember)
End If
Next
End Sub
Sub EnumGroup(objADGroup)
Dim strFilter, strAttributes, objRecordSet, intGroupToken
Dim objMember, strQuery, strNTName
' Retrieve "primaryGroupToken" of group.
objADGroup.GetInfoEx Array("primaryGroupToken"), 0
intGroupToken = objADGroup.Get("primaryGroupToken")
' Use ADO to search for users whose "primaryGroupID" matches the
' group "primaryGroupToken".
strFilter = "(primaryGroupID=" & intGroupToken & ")"
strAttributes = "sAMAccountName"
strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter & ";" _
& strAttributes & ";subtree"
'WScript.echo strQuery
objCommand.CommandText = strQuery
Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
strNTName = objRecordSet.Fields("sAMAccountName")
'ADGroupName = FixValue(ObjADGroup.AdsPath)' use this for ADGroupName if you just want the ADS Path
ADGroupName = Mid(FixValue(ObjADGroup.Name),4)
SamAccountName = FixValue(strNTName)
Department = "Test"
UserAdsPath = "Ads"
qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, SamAccountName, Department,CN, UserAdsPath) VALUES ('" & ADGroupName & "','" & SamAccountName & "','" & Department & "', '" & CN & "', '" & UserAdsPath & "')"
conn.Execute (qryInsert)
objRecordSet.MoveNext
Loop
For Each objMember In objADGroup.Members
'ADGroupName = FixValue(objADGroup.AdsPath) ' use this for ADGroupName if you just want the ADS Path
ADGroupName = Mid(FixValue(objADGroup.Name),4)
GroupDescription = FixValue(objadgroup.Description)
LastName = FixValue(objMember.sn)
FirstName = FixValue(objMember.GivenName)
Manager = FixValue(objMember.Manager)
SamAccountName = FixValue(objMember.SamAccountName)
Department = FixValue(ObjMember.Department)
UserADSPath = FixValue(objMember.AdsPath)
qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, GroupDescription, LastName, FirstName, ManagerAdsPath, SamAccountName, Department,CN, UserAdsPath) VALUES ('" & ADGroupName & "', '" & GroupDescription & "', '" & LastName & "', '" & FirstName & "', '" & Manager & "', '" & SamAccountName & "', '" & Department & "', '" & CN & "', '" & UserAdsPath & "')"
conn.Execute (qryInsert)
Next
Set objMember = Nothing
Set objRecordSet = Nothing
End Sub
conn.close
Set Conn = Nothing
MSgbox "Done"
Function FixValue(sValue)
FixValue = Replace(sValue,"'","''")
End Function
Sub WriteGroup(strGroupName)
WScript.Echo "WinNT://HEI/" & strGroupName
On Error Resume Next
Err.Clear
Set ObjGroup = GetObject("WinNT://HEI/" & strGroupName)
WScript.Echo Err.Number
If Err.Number <> 0 Then
strGroupName = mid(strGroupName,2)
WScript.echo strGroupName
Set ObjGroup = GetObject("WinNT://HEI/" & strGroupName)
End If
Err.Clear
On Error Goto 0
For Each objMember In objGroup.Members
Set objUser = GetObject("WinNT://HEI/" & ObjMember.Name)
ADGroupName = ObjGroup.Name
SamAccountName = FixValue(ObjMember.Name)
If UCase(objMember.Class) <> "GROUP" Then
CN = FixValue(ObjMember.FullName)
Else
CN = "GroupWithinGroup"
End If
UserAdsPath = FixValue(ObjMember.AdsPath)
qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, GroupDescription, LastName, FirstName, ManagerAdsPath, SamAccountName, Department,CN, UserAdsPath) VALUES ('" & ADGroupName & "', '" & GroupDescription & "', '" & LastName & "', '" & FirstName & "', '" & Manager & "'. '" & SamAccountName & "','" & Department & "', '" & CN & "', '" & UserAdsPath & "')"
conn.Execute (qryInsert)
Next
End Sub
|
|
| |
|
|
|
|
|
Printable Version
New Messages
No New Messages
Hot Topic w/ New Messages
Hot Topic w/o New Messages
Locked w/ New Messages
Locked w/o New Messages
Post New Thread