How to disable a user in Active Directory

Const ADS_UF_ACCOUNTDISABLE = 2

Set objUser = GetObject _
("LDAP://cn=username,ou=support,dc=domain,dc=com")
intUAC = objUser.Get("userAccountControl")

objUser.Put "userAccountControl", intUAC OR ADS_UF_ACCOUNTDISABLE
objUser.SetInfo 

How to create a user in Active Directroy

Set objOU = GetObject("LDAP://OU=AUS,dc=domain,dc=com")
Set objUser = objOU.Create("User", "cn=username")
objUser.Put "sAMAccountName", "username"
objUser.SetInfo 

How to Delete OU in Active Directory

Set obj_Domain = GetObject("LDAP://dc=domain,dc=com")
obj_Domain.Delete "organizationalUnit", "ou=OU NAME"
 

How to create OU in Active Directory

Set obj_Domain = GetObject("LDAP://dc=domain,dc=com")

Set obj_OU = obj_Domain.Create("organizationalUnit", "ou=Management")
obj_OU.SetInfo

How to set user password in Active Direcotyr(AD)

Set objUser = GetObject("LDAP://cn=cn,ou=ou,dc=dc,dc=com")
objUser.SetPassword "password"

.NET function to get user groups from Active Directory

Below .NET function is used to get the user groups from Active Directory.

To use the below function in your project, you need to add the reference for System.DirectoryServices


Public Function GetUserGroupMembership(ByVal strUser As String) As StringCollection  Dim groups As New StringCollection()
Try
  Dim obEntry As New DirectoryServices.DirectoryEntry("LDAP://domain/DC=domain,DC=com")
  Dim srch As New DirectoryServices.DirectorySearcher(obEntry, "(sAMAccountName=" & strUser & ")")
  Dim res As DirectoryServices.SearchResult = srch.FindOne()
      If res IsNot Nothing Then
        Dim obUser As New DirectoryServices.DirectoryEntry(res.Path)
        ' Invoke Groups method.
        Dim obGroups As Object = obUser.Invoke("Groups")
        For Each ob As Object In DirectCast(obGroups, IEnumerable)
        ' Create object for each group.
        Dim obGpEntry As New DirectoryServices.DirectoryEntry(ob)
                    groups.Add(obGpEntry.Name)
        Next
      End If
Catch ex As Exception            'Trace.Write(ex.Message)
End Try
        Return groups
End Function


Above function can be called as :
Dim Groups As StringCollection = GetUserGroupMembership(username.text)

.NET function to get user information from Active Directory

Below script is a .NET function to get information about a user from AD. This information can be stored in a variable and used in your project/application.

To use the below function in your project, you need to add the reference for System.DirectoryServices


Public Function GetUserInfo(ByVal inAD As String, ByVal inType As String) As String
Try
    Dim sPath As String= "LDAP://domain/DC=domain,DC=com"
    Dim SamAccount As String = Right(inAD, Len(inAD) - InStr(inAD, "\"))
    Dim myDirectory As New DirectoryServices.DirectoryEntry(sPath, "username", "Password")
    Dim mySearcher As New DirectoryServices.DirectorySearcher(myDirectory)
    Dim mySearchResultColl As DirectoryServices.SearchResultCollection
    Dim mySearchResult As DirectoryServices.SearchResult
    Dim myResultPropColl As DirectoryServices.ResultPropertyCollection
    Dim myResultPropValueColl As DirectoryServices.ResultPropertyValueCollection
    'Build LDAP query
    mySearcher.Filter = ("(&(objectClass=user)(samaccountname=" & SamAccount & "))")
    mySearchResultColl = mySearcher.FindAll()
    'only one user from search result
            Select Case mySearchResultColl.Count
                Case 0
                    Return "0"
                    Exit Function
                Case Is > 1
                    Return "1"
                    Exit Function
            End Select
            'Search result from the collection
            mySearchResult = mySearchResultColl.Item(0)
           
     'Properites, they contain the usefull info
            myResultPropColl = mySearchResult.Properties
            myResultPropValueColl = myResultPropColl.Item(inType)
            Return CStr(myResultPropValueColl.Item(0))

Catch ex As System.Exception           
    Return 0
End Try
End Function

Above function can be called as below:
Variablename = GetUserInfo(usernametexbox.text, "displayname")
where displayname is the property name in Active Directory

Update Computer Description in Active Directory

Below VB script allows you to update the Computer description from CSV file in Active directiory


set Input_Connection = createobject("adodb.connection")
set Input_RecordSet = createobject("adodb.recordset")
Comp_Location ="C:\AD\"
    'CONNECT TO CSV file
    Input_Connection.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & _
    Comp_Location & ";Extended Properties=""text;HDR=YES;FMT=Delimited"""
    Input_RecordSet.open "SELECT * FROM Computers.csv",Input_Connection
strDomain= DOMAIN_NAME
Set objRootLDAP = GetObject("LDAP://RootDSE")
strDNSDomain = objRootLDAP.Get("DefaultNamingContext")
strOU = OU PATH
set objRootDSE = GetObject("LDAP://" & strDomain & "/RootDSE")
set objContainer = GetObject("LDAP://cn=Computers," & objRootDSE.Get("defaultNamingContext"))
set oLogObject = CreateObject("Scripting.FileSystemObject")
set oLogOutput = oLogObject.CreateTextFile("C:\UsersComputer.log")
oLogOutput.WriteLine Now & ": Log started"
On Error Resume Next
do until Input_RecordSet.EOF
    oLogOutput.WriteLine "A:" & strComputer & strOU & strDNSDomain
    strDescr =Input_RecordSet.Fields.Item(1).Value
    strComputer = "CN=" & Input_RecordSet.Fields.Item(0).Value & ","
    set objComputer = GetObject("LDAP://"& strComputer & strOU & strDNSDomain)
    objComputer.Put "description", strDescr
    objComputer.SetInfo
Input_RecordSet.movenext
Loop   

Get Users from a specific Group in Active Directory

This script prompts for Group name and export the details into Excel

Option Explicit
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
With objExcel
    .Visible = True
    .DisplayAlerts = False
    Dim objWorkBook : Set objWorkBook = .WorkBooks.Add
    Dim objSheet : Set objSheet = .Worksheets(1)
End With
Create_Excel_File()
Dim intRow : intRow = 2
Dim strGroup : strGroup = InputBox("Enter the Group Name")
On Error Resume Next
    Dim objGroup : Set objGroup = GetObject("LDAP://" & GetDN(strGroup))
if err.number <> 0 then
    Msgbox err.number & " : Error Occured during process." & vbcrlf & "The Group " & strGroup & " does not exist."
    err.Clear
End If
Enum_Members(objGroup)
Format_Excel_File()

Sub Create_Excel_File()
    With objSheet
        '.Name = "Data"
        .Cells(1, 1).Value = "UserName"
        .Cells(1, 2).Value = "First Name"
        .Cells(1, 3).Value = "Last Name"
        .Cells(1, 4).Value = "Title"
        .Cells(1, 5).Value = "Work Phone"
        .Cells(1, 6).Value = "Mobile Phone"
        .Cells(1, 7).Value = "Pager"
        .Cells(1, 8).Value = "Home Phone"
 .Cells(1, 9).Value = "Dept"
 .Cells(1, 10).Value = "City"
 .Cells(1, 11).Value = "Country"
 .Cells(1, 12).Value = "Date Created"
    End With
    Dim objRange : Set objRange = objSheet.UsedRange
    objRange.Select
    With objRange
        .Font.Bold = True
        .Font.Name = "Arial"
        .Font.Size = 10
        .WrapText = False
        .HorizontalAlignment = -4108
        .Interior.ColorIndex = 37
        .Cells.RowHeight = 25       
    End With
End Sub
Sub Format_Excel_File()
    Const xlsEdgeBottom = 9
    Const xlsEdgeLeft = 7
    Const xlsEdgeRight = 10
    Const xlsEdgeTop = 8
    Const xlsInsideHorizontal = 12
    Const xlsInsideVertical = 11
    Const xlsContinuous = 1
    Const xlsAutomatic = -4105
    Const xlsMedium = -4138
    Dim objRange : Set objRange = objSheet.UsedRange
    objRange.Select
   
    objRange.Columns.AutoFit
    Dim arrBorders : arrBorders = Array(xlsEdgeLeft, xlsEdgeTop, xlsEdgeBottom, xlsEdgeRight, xlsInsideVertical, xlsInsideHorizontal)
    Dim intBorder
    For Each intBorder in arrBorders
        With objRange.Borders(intBorder)
            .LineStyle = xlsContinuous
            .Weight = xlsMedium
            .ColorIndex = xlsAutomatic
        End With
    Next
End Sub

Sub Enum_Members(group)
    Dim arrAttributes : arrAttributes = Array("samaccountName", "GivenName", "sn", "Title", "telephonenumber", "Mobile", "Pager", "homePhone", "department", "l", "co", "whencreated")
    Dim objItem
    For Each objItem in group.Members
        If objItem.Class = "user" Then
            Dim intColumn : intColumn = 1
            Dim objUser : Set objUser = GetObject(objItem.AdsPath)
            Dim strAttrib
            For Each strAttrib in arrAttributes
                On Error Resume Next
                objSheet.Cells(intRow, intColumn).Value = objItem.Get(strAttrib)
                On Error GoTo 0
                intColumn = intColumn + 1
            Next
        End If           
        intRow = intRow + 1
    Next
    For Each objItem in group.Members
        If objItem.Class = "group" Then
            Call Enum_Members(objItem)
        End If
    Next
End Sub
Function GetDN(samAccount)
On Error Resume Next
      If Not IsObject(objWSHNetwork) Then
        Dim objWSHNetwork : Set objWSHNetwork = WScript.CreateObject("WScript.Network")
      End If
      Dim NT : Set NT= CreateObject("NameTranslate")
      NT.Init 3, ""
      NT.Set 3, objWSHNetwork.UserDomain & "\" & samAccount
      GetDN = NT.Get(1)
if err.number <> 0 then
    Msgbox err.number & " : Error Occured during process." & vbcrlf & "The Group " & strGroup & " does not exist."
    err.Clear
End If
End Function

Get groups of a specific users from Active Directory

This scrpit will prompt to enter Domain and User name and will export the User groups from Active Directory in Excel File

Option Explicit
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
With objExcel
    .Visible = True
    .DisplayAlerts = False
    Dim objWorkBook : Set objWorkBook = .WorkBooks.Add
    Dim objSheet : Set objSheet = .Worksheets(1)
End With
Dim objNetwork, strDomain, strUser, objUser, objGroup, strGroupMemberships
'Get the domain and username from the WScript.Network object
Set objNetwork = CreateObject("WScript.Network")
strDomain = InputBox("Enter the Domain Name")
strUser = InputBox("Enter the User Name")
if strUSer <> "" then
'Instanciate the user object from the data above
Set objUser = GetObject("WinNT://" & strDomain & "/" & strUser)
'Run through the users groups and put them in the string
Create_Excel_Header(strUser)
Dim intRow : intRow = 2
Dim intColumn : intColumn = 1
For Each objGroup In objUser.Groups
    objSheet.Cells(intRow, 1 ).Value = objGroup.Name
    intRow = intRow  + 1
Next
else
 MSgbox "Error Processing your request",vbCritical,"Preetech Software Solutions"
End If
Format_Excel_File()
Sub Create_Excel_Header(strUser)
    With objSheet
        .Cells(1, 1).Value = "Group(s) of User:" & strUser
    End With
    Dim objRange : Set objRange = objSheet.UsedRange
    objRange.Select
    With objRange
        .Font.Bold = True
        .Font.Name = "Arial"
        .Font.Size = 10
        .WrapText = False
        .HorizontalAlignment = -4108
        .Interior.ColorIndex = 37
        .Cells.RowHeight = 25       
    End With
End Sub
Sub Format_Excel_File()
    Const xlsEdgeBottom = 9
    Const xlsEdgeLeft = 7
    Const xlsEdgeRight = 10
    Const xlsEdgeTop = 8
    Const xlsInsideHorizontal = 12
    Const xlsInsideVertical = 11
    Const xlsContinuous = 1
    Const xlsAutomatic = -4105
    Const xlsMedium = -4138
   
    Dim objRange : Set objRange = objSheet.UsedRange
    objRange.Select
   
    objRange.Columns.AutoFit
   
    Dim arrBorders : arrBorders = Array(xlsEdgeLeft, xlsEdgeTop, xlsEdgeBottom, xlsEdgeRight, xlsInsideVertical, xlsInsideHorizontal)
    Dim intBorder
   
    For Each intBorder in arrBorders
        With objRange.Borders(intBorder)
            .LineStyle = xlsContinuous
            .Weight = xlsMedium
            .ColorIndex = xlsAutomatic
        End With
    Next
End Sub