Code:
Main Sub.
' Global variables.
Dim objBook
Dim intRowGroup
Dim XL
Dim FSO
Dim strGroupOnly
Dim strDomain
' Create Global instance of Excel object.
Set XL = WScript.CreateObject("Excel.Application")
' Initialize Global File System Object
Set FSO = CreateObject("Scripting.FileSystemObject")
' Start to write to row 6 in Excel File.
intRowGroup = 6
' Create Excel File.
BuildSpreadSheet
' Create GroupList text file.
CreateGroupList
' Find users for each group.
FindUsersInGroup
' Save Excel File.
SaveSpreadSheet
--------------------------------------------------------
Sub CreateGroupList()
On Error Resume Next
Dim rootDSE
Dim strDomain
Dim adodbConn
Dim objCatalog
Dim objCommand
Dim rsConnection
Dim strGroupScope
Dim strSecurityGroup
' Constants for all types of group in domain.
Const ADS_GROUP_TYPE_GLOBAL_GROUP = &h00000002
Const ADS_GROUP_TYPE_DOMAIN_LOCAL_GROUP = &h00000004
Const ADS_GROUP_TYPE_LOCAL_GROUP = &h00000004
Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h00000008
Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000
' Concatenate the two type for a Global Security group.
strGroupScope = ADS_GROUP_TYPE_GLOBAL_GROUP or ADS_GROUP_TYPE_SECURITY_ENABLED
' Connect to domain.
Set RootDSE = GetObject("[link=http://www.visualbasicscript.com/ldap://RootDSE]LDAP://RootDSE[/link]")
Set strDomain = GetObject("LDAP://"&RootDSE.get("DefaultNamingContext"))
' Select query to filter only Global Security Group.
strQuery="Select cn,distinguishedname,groupType from '" & _
strDomain.ADSPath & "' Where objectclass='group' AND GroupType='" & strGroupScope & "'"
'WScript.Echo strQuery
' Connect to Global Catalog in domain.
Set objCatalog = GetObject("GC:")
For Each objFound In objCatalog
Set objGC = objFound
Next
' Get the path of Global Catalog.
AdsPath = objGC.ADSPath
' Open a connection to Active Directory Directory.
Set adodbConn = Createobject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
adodbConn.Provider = "ADSDSOObject"
adodbConn.Open
' Open a recordset to populate all Global Security Groups in AD.
Set objCommand.ActiveConnection = adodbConn
Set rsConnection = adodbConn.Execute(strQuery)
Do While Not rsConnection.EOF
strSecurityGroup = strSecurityGroup & rsConnection.Fields("distinguishedname") & vbcrlf
rsConnection.Movenext
Loop
' Close connection variables
rsConnection.Close
adodbConn.Close
Set adodbConn=Nothing
Set objCommand=Nothing
Set RootDSE=Nothing
Set objCatalog=Nothing
Set rsConnection=nothing
' Create a text file containing all Global Security Groups for later use.
CreateTempFile strSecurityGroup, "GroupList.txt"
End Sub
-------------------------------------------
Sub CreateTempFile (strSource, strFileName)
Dim strTempFile
' Create text file based on strFileName containing values from strSource.
Set strTempFile = FSO.OpenTextFile(strFileName, 2, True)
strTempFile.WriteLine(strSource)
strTempFile.Close
End Sub
---------------------------------------------------
Function FindUsersInGroup() 'Find all members in each group from a text file.
Dim arrMemberOf
Dim objGroup
Dim strUsers
Dim strTemp
Dim intPos
Dim strGroup
Dim strFirstChar
Dim strTempFile
Dim strMember
On Error Resume Next
' Open text file GroupList.txt containing all Global Security Groups.
Set strTempFile = FSO.OpenTextFile("GroupList.txt",1, True)
' Store first line to save Excel file later.
strDomain = strTempFile.ReadLine
Do Until strTempFile.AtEndOfStream
' Read one group at a time.
strGroup = strTempFile.ReadLine
' Check if there is something in strGroup.
' I don't know why last group is always empty.
strFirstChar = Left(strGroup,1)
If Len(strGroup) = 0 Then
Exit Function
End If
' Connect to this group in AD.
Set objGroup = GetObject("LDAP://" & strGroup)
objGroup.GetInfo
' Parse current line to extract only group name.
strGroupOnly = GetGroupOnly(strGroup)
' Get all members in current group.
arrMemberOf = objGroup.GetEx("member")
---------------------------------------------------------
For Each strMember in arrMemberOf
strTemp = strMember
' Parse current line to extract only user name.
If InStr(strTemp,",") Then
intPos = InStr(strTemp, ",")
strTemp = Mid(strTemp, 1, intPos - 1)
strTemp = Mid(strTemp,4)
End if
' Concatenate all users for current group.
strUsers = strUsers & strTemp & vbcrlf
Next
' Create temporary text file containing all users for current group.
CreateTempFile strUsers, "UserList.txt"
' Call procedure to add current group and all users it contain in the Excel file.
AddGroupToSpreadSheet strGroupOnly, "UserList.txt"
' Reset variable.
strUsers = ""
arrMemberOf = ""
Loop
End Function
--------------------------------------
Sub AddGroupToSpreadSheet(strGroup, strUsers) ' Add one group at a time with all members in an Excel file.
Dim strTempFile
' Will insert a blank line in Excel file after last group.
intRowGroup = intRowGroup + 1
' Write current group in first column.
XL.Cells(intRowGroup, 1).Value = UCase(strGroup)
' Open temporary text file containing users for current group.
Set strTempFile = FSO.OpenTextFile(strUsers,1, True)
Do Until strTempFile.AtEndOfStream
' Write users for current group in third column.
XL.Cells(intRowGroup, 3).Value = strTempFile.ReadLine
intRowGroup = intRowGroup + 1
Loop
strTempFile.Close
End Sub
Function GetDomain(strFile)
Dim strTemp
Dim intPos
' Parse line to extract only the Domain name.
' strList contain CN=Domain Computers,CN=Users,DC=Mydomain,DC=local
If InStr(strFile,"DC=") Then
intPos = InStr(strFile, "DC=")
strTemp = Mid(strFile, intPos + 3)
If InStr(strTemp, ",") Then
intPos = InStr(strTemp, ",")
strTemp = Mid(strTemp, 1, intPos - 1)
End If
End If
' strTemp contain only Mydomain
GetDomain = strTemp
End Function
'--------------------------------------------------------------------------------------------------
Sub BuildSpreadSheet() ' Create Excel File.
' Format cells from row 1 to 3 with fixed width column.
XL.Visible = True
Set objBook = XL.WorkBooks.Add
XL.Columns(1).ColumnWidth = 35
XL.Columns(2).ColumnWidth = 1
XL.Columns(3).ColumnWidth = 65
'XL.Cells(1, 4).Value = objDir
' Create Header for column 1 and 3
XL.Cells(2, 1).Value = "Legend:"
XL.Cells(2, 3).Value = "Date of extraction " & Now()
XL.Cells(4, 1).Value = "Group Name"
XL.Cells(4, 3).Value = "User in Group"
' Select range and format it Bold with font size 12.
XL.Range("A1:D4").Select
XL.Selection.Font.Bold = True
XL.Selection.Font.Size = 12
End Sub
'--------------------------------------------------------------------------------------------------
Sub SaveSpreadSheet() ' Save Excel file.
Dim ObjWorkbook
Dim strDate
Dim strXlFile
Dim strDomainName
' Parse strDomain variable to extract Domain name.
strDomainName = GetDomain(strDomain)
Set objWorkbook = XL.ActiveWorkbook
strDate = Date
strDate = Replace(strDate, "/", "-")
' Find script path to save Excel file in it with prefix + current date and .xls extension.
strXlFile = GetScriptPath() & "GlobalSecGroup_InDomain_" & strDomainName & "_" & strDate & ".xls"
strXlFile = XL.GetSaveAsFilename(strXlFile)
If strXlFile <> False Then
ObjWorkbook.SaveAs(strXlFile)
End If
'XL.Quit
End Sub
'--------------------------------------------------------------------------------------------------
Function GetScriptPath() ' Find path from where this script is executed.
GetScriptPath = MID(Wscript.ScriptFullName, 1, InstrRev(Wscript.ScriptFullName,"\"))
End Function
Bookmarks