Solved

Script by Rob to create users and contacts in one shot. Need to add the ability to accept the manager name also from the excel.

Posted on 2008-10-24
49
492 Views
Last Modified: 2008-11-18
Hi,

Script by Rob to create users and contacts in one shot. Need to add the ability to accept the manager name also from the excel.
Excel looks as this. Can i have a colum in "F" so i can add the manager name also.

First Name      Last Name      Full Name      Login (@development.group.co.uk)      Email      Groups      Description      Office      Mobile      Title      Department      Company      Address      City      State      Zipcode      Country      Home Phone        Phone


Regards
Sharath

'====================

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

      strPath = Wscript.ScriptFullName

      strCommand = "%comspec% /k cscript  """ & strPath & """"

      Set objShell = CreateObject("Wscript.Shell")

      objShell.Run(strCommand), 1, True

      Wscript.Quit

End If
 

' Bind to Active Directory.

Set objRootLDAP = GetObject("LDAP://rootDSE")
 

' CONFIGURATION PARAMETERS FOR THE SCRIPT

' ******** USERS *************

strExcelFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Users_and_Contacts_Sharath.xls"
 

strUserOUPath = "OU=CS,OU=External users,OU=User Accounts,OU=IND,OU=Countries," & objRootLDAP.Get("defaultNamingContext")

strPassword = "abc123"

' ******** CONTACTS *************
 

strContactOUPath = "OU=CS,OU=contacts,OU=User Accounts,OU=IND,OU=Countries," & objRootLDAP.Get("defaultNamingContext")

' END CONFIGURATION PARAMETERS
 

Const xlUp = -4162

Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000

Const ADS_PROPERTY_CLEAR = 1

Const ADS_PROPERTY_UPDATE = 2

Const ADS_PROPERTY_APPEND = 3

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

objExcel.Workbooks.Open strExcelFile
 

Set objNetwork = CreateObject("WScript.Network")

strDomainName = objNetwork.UserDomain
 

For intRow = 2 To objExcel.ActiveSheet.Cells(65536, "A").End(xlUp).Row
 

      strFirstName = Trim(objExcel.ActiveSheet.Cells(intRow, "A").Value)

      strLastName = Trim(objExcel.ActiveSheet.Cells(intRow, "B").Value)

      strFullName = Trim(objExcel.ActiveSheet.Cells(intRow, "C").Value)

      strUserNameHeading = Mid(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), InStr(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), "@"),Len(Trim(objExcel.ActiveSheet.Cells(1, "D").Value)) - InStr(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), "@"))

      strUserName = Trim(objExcel.ActiveSheet.Cells(intRow, "D").Value) & strUserNameHeading

      strEmail = Trim(objExcel.ActiveSheet.Cells(intRow, "E").Value)

      strGroups = Trim(objExcel.ActiveSheet.Cells(intRow, "F").Value)

      strDescription = Trim(objExcel.ActiveSheet.Cells(intRow, "G").Value)

      strAlias = strFirstName & strLastName

      strOffice = Trim(objExcel.ActiveSheet.Cells(intRow, "H").Value)

      strMobile = Trim(objExcel.ActiveSheet.Cells(intRow, "I").Value)

      strTitle = Trim(objExcel.ActiveSheet.Cells(intRow, "J").Value)

      strDepartment = Trim(objExcel.ActiveSheet.Cells(intRow, "K").Value)

      strCompany = Trim(objExcel.ActiveSheet.Cells(intRow, "L").Value)

      strAddress = Trim(objExcel.ActiveSheet.Cells(intRow, "M").Value)

      strCity = Trim(objExcel.ActiveSheet.Cells(intRow, "N").Value)

      strState = Trim(objExcel.ActiveSheet.Cells(intRow, "O").Value)

      strZipCode = Trim(objExcel.ActiveSheet.Cells(intRow, "P").Value)

      strCountry = Trim(objExcel.ActiveSheet.Cells(intRow, "Q").Value)

      strHomePhone = Trim(objExcel.ActiveSheet.Cells(intRow, "R").Value)

      

      'strFirstName = Trim(Left(strFullName, InStrRev(strFullName, " ") - 1))

      'strLastName = Trim(Mid(strFullName, InStrRev(strFullName, " ") + 1))

            

      If strFullName <> "" And strUserName <> "" Then

            

            WScript.Echo "About to create:" & VbCrLf &_

                  strFullName & VbCrLf &_

                  strFirstName & VbCrLf &_

                  strLastName & VbCrLf & _

                  strUserName & VbCrLf &_

                  strPassword & VbCrLf &_

                  "LDAP://" & strUserOUPath

                  

            ' This will add the user to eg. Domain.Local\Users

            Set objContainer = GetObject("LDAP://" & strUserOUPath) 

            

            ' Check if the user already exists

            On Error Resume Next

            

            Set objNewUser = GetObject("LDAP://cn=" & strFullName & "," & strUserOUPath)

            If Err.Number = 0 Then

                  WScript.Echo "User " & strFullName & " already exists."

                  On Error GoTo 0

            Else

                  Err.Clear

                  On Error GoTo 0

                  

                  ' Build the actual User.

                  ' Attributes listed here: http://support.microsoft.com/kb/555638

                  Set objNewUser = objContainer.Create("User", "cn= " & strFullName)

                  'objNewUser.Put "userPrincipalName", strUserName & "@" & Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")

                  If InStr(strUserName, "@") > 0 Then

                        arrDomUserName = Split(strUserName, "@")

                        strUserName = arrDomUserName(0)

                        strSuffix = arrDomUserName(1)

                  Else

                        strUserName = strUserName

                        strSuffix = Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")

                  End If

                  objNewUser.Put "userPrincipalName", strUserName & "@" & strSuffix

                  objNewUser.Put "sAMAccountName", strUserName

                  objNewUser.Put "givenName", strFirstName

                  objNewUser.Put "sn", strLastName

                  objNewUser.Put "displayName", strFullName

                  'If strEmail <> "" Then objNewUser.Put "mail", strEmail

                  If strDescription <> "" Then objNewUser.Put "description", strDescription

                  If strOffice <> "" Then objNewUser.Put "physicalDeliveryOfficeName", strOffice

                  If strMobile <> "" Then objNewUser.Put "mobile", strMobile

                  If strTitle <> "" Then objNewUser.Put "title", strTitle

                  If strDepartment <> "" Then objNewUser.Put "department", strDepartment

                  If strCompany <> "" Then objNewUser.Put "company", strCompany

                  If strAddress <> "" Then objNewUser.Put "streetAddress", strAddress

                  If strCity <> "" Then objNewUser.Put "l", strCity

                  If strState <> "" Then objNewUser.Put "st", strState

                  If strZipCode <> "" Then objNewUser.Put "postalCode", strZipCode

                  ' ISO Country Code list: http://www.iso.org/iso/english_country_names_and_code_elements

                  If strCountry <> "" Then objNewUser.Put "c", strCountry

                  If strHomePhone <> "" Then objNewUser.Put "homePhone", strHomePhone

                  objNewUser.SetInfo

                  objNewUser.SetPassword strPassword

                  objNewUser.AccountDisabled = False

                  objNewUser.SetInfo

                  

                  intUserAccountControl = objNewUser.Get("userAccountControl") 

                  If Not objNewUser.userAccountControl AND ADS_UF_DONT_EXPIRE_PASSWD Then

                        objNewUser.Put "userAccountControl", objNewUser.userAccountControl XOR ADS_UF_DONT_EXPIRE_PASSWD

                        objNewUser.SetInfo

                  End If

                

                  If strGroups <> "" Then

                        arrGroups = Split(strGroups, ":")

                        For Each strGroupName In arrGroups

                              strGroupPath = Get_LDAP_User_Properties("group", "cn", strGroupName, "adsPath")

                              If strGroupPath <> "" Then

                                    Set objGroup = GetObject(strGroupPath)

                                    On Error Resume Next

                                    objGroup.Add objNewUser.AdsPath

                                    If Err.Number <> 0 Then

                                          WScript.Echo Err.Number & ": " & Err.Description & " - cannot add " & objNewUser.AdsPath & " to " & objGroup.adspath

                                          Err.Clear

                                          boolUserAdded = False

                                          arrSid = objNewUser.objectSid

                                          strSidHex = OctetToHexStr(arrSid)

                                          strSidDec = HexStrToDecStr(strSidHex)

                                          objGroup.Add "LDAP://<SID=" & strSidDec & ">"

                                          If Err.Number <> 0 Then

                                                WScript.Echo Err.Number & ": " & Err.Description & " - cannot add " & strSidDec & " to " & objGroup.adspath

                                                Err.Clear

                                                boolUserAdded = False

                                                objGroup.Add "LDAP://CN=" & strSidDec & ",CN=ForeignSecurityPrincipals," & Mid(objNewUser.AdsPath, InStr(objNewUser.AdsPath, "DC="))

                                                If Err.Number <> 0 Then

                                                      WScript.Echo Err.Number & ": " & Err.Description & " - cannot add LDAP://CN=" & strSidDec & ",CN=ForeignSecurityPrincipals," & Mid(objNewUser.AdsPath, InStr(objNewUser.AdsPath, "DC=")) & " to " & objGroup.adspath

                                                      Err.Clear

                                                      boolUserAdded = False

                                                Else

                                                      boolUserAdded = True

                                                End If

                                          Else

                                                boolUserAdded = True

                                          End If

                                    Else

                                          boolUserAdded = True

                                    End If

                                    On Error GoTo 0

                                    If boolUserAdded = True Then

                                          WScript.Echo "User " & strUserName & " was added to the group " & objGroup.AdsPath

                                    Else

                                          WScript.Echo "Could not add user " & strUserName & " to the group " & strGroupName

                                    End If

                                    Set objGroup = Nothing

                              Else

                                    WScript.Echo "Could not locate the group " & strGroupName & " to add the user " & objNewUser.samAccountName & " to."

                              End If

                        Next

                  End If

            End If

            

            ' ********** CONTACT CREATION *************

            Set objContactsContainer = GetObject("LDAP://" & strContactOUPath)

            

            ' Check if the contact already exists

            On Error Resume Next

            

            Set objNewContact = GetObject("LDAP://cn=" & strFullName & "," & strContactOUPath)

            If Err.Number = 0 Then

                  WScript.Echo "Contact " & strFullName & " already exists."

                  On Error GoTo 0

            Else

                  Err.Clear

                  On Error GoTo 0
 

                  ' Build the actual Contact.

                  Set objContact = objContactsContainer.Create("Contact","cn=" & strFullName)

                  objContact.Put "Mail", strEmail

                  objContact.Put "givenName", strFirstName

                  objContact.Put "sn", strLastName

                  objContact.Put "displayName", strFullName

                  objContact.Put "mailNickname", Cstr(strAlias)

                  objContact.Put "targetAddress", "SMTP:" & strEmail

                  On Error Resume Next

                  objGroup.PutEx ADS_PROPERTY_CLEAR, "proxyAddresses", 0

                  objContact.SetInfo

                  On Error GoTo 0

                  objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail,"SMTP:" & strAlias & "@" & Mid(Replace(objRootLDAP.Get("defaultNamingContext"), "DC=", "."), 2))

                  objContact.SetInfo

                  If strOffice <> "" Then objContact.Put "physicalDeliveryOfficeName", strOffice

                  If strDescription <> "" Then objContact.Put "description", strDescription

                  If strMobile <> "" Then objContact.Put "mobile", strMobile

                  If strTitle <> "" Then objContact.Put "title", strTitle

                  If strDepartment <> "" Then objContact.Put "department", strDepartment

                  If strCompany <> "" Then objContact.Put "company", strCompany

                  If strAddress <> "" Then objContact.Put "streetAddress", strAddress

                  If strCity <> "" Then objContact.Put "l", strCity

                  If strState <> "" Then objContact.Put "st", strState

                  If strZipCode <> "" Then objContact.Put "postalCode", strZipCode

                  ' ISO Country Code list: http://www.iso.org/iso/english_country_names_and_code_elements

                  If strCountry <> "" Then objContact.Put "c", strCountry

                  If strHomePhone <> "" Then objContact.Put "homePhone", strHomePhone

                  

                  objContact.SetInfo

                  WScript.Echo "Contact " & strAlias & " created."

            End If

      End If

Next
 

WScript.Echo "Done"

objExcel.ActiveWorkbook.Close False

objExcel.Quit

Set objExcel = Nothing
 

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

      

      If InStr(strObjectToGet, "\") > 0 Then

            arrGroupBits = Split(strObjectToGet, "\")

            strDC = arrGroupBits(0)

            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")

            strObjectToGet = arrGroupBits(1)

      Else

            Set objRootDSE = GetObject("LDAP://RootDSE")

            'strDNSDomain = objRootDSE.Get("defaultNamingContext")

            strDNSDomain = objRootDSE.Get("RootDomainNamingContext")

      End If
 

      strBase = "<LDAP://" & strDNSDomain & ">"

      ' Setup ADO objects.

      Set adoCommand = CreateObject("ADODB.Command")

      Set adoConnection = CreateObject("ADODB.Connection")

      adoConnection.Provider = "ADsDSOObject"

      adoConnection.Open "Active Directory Provider"

      adoCommand.ActiveConnection = adoConnection
 

 

      ' Filter on user objects.

      'strFilter = "(&(objectCategory=person)(objectClass=user))"

      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
 

      ' Comma delimited list of attribute values to retrieve.

      strAttributes = strCommaDelimProps

      arrProperties = Split(strCommaDelimProps, ",")
 

      ' Construct the LDAP syntax query.

      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

      adoCommand.CommandText = strQuery

      adoCommand.Properties("Page Size") = 100

      adoCommand.Properties("Timeout") = 30

      adoCommand.Properties("Cache Results") = False
 

      ' Run the query.

      On Error Resume Next

      Set adoRecordset = adoCommand.Execute

      If Err.Number = 0 Then

            On Error GoTo 0

            ' Enumerate the resulting recordset.

            Do Until adoRecordset.EOF

                ' Retrieve values and display.    

                For intCount = LBound(arrProperties) To UBound(arrProperties)

                      If strDetails = "" Then

                            strDetails = adoRecordset.Fields(intCount).Value

                      Else

                            strDetails = strDetails & VbCrLf & adoRecordset.Fields(intCount).Value

                      End If

                Next

                ' Move to the next record in the recordset.

                adoRecordset.MoveNext

            Loop

      

            ' Clean up.

            adoRecordset.Close

        Else

              Err.Clear

              On Error GoTo 0

            strDetails = ""

        End If

      adoConnection.Close

      If InStr(strDNSDomain, "/") > 0 Then

            Get_LDAP_User_Properties = Replace(strDetails, Left(strDNSDomain, InStr(strDNSDomain, "/")), "")

      Else

            Get_LDAP_User_Properties = strDetails

      End If
 

End Function
 

'Working VBScript Active Directory Binary SID conversion to String SID

' Source: http://forums.techarena.in/showthread.php?t=588078

'Function to convert OctetString (byte array) to Hex string.

Function OctetToHexStr(arrbytOctet)

Dim k

OctetToHexStr = ""

For k = 1 To Lenb(arrbytOctet)

OctetToHexStr = OctetToHexStr & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)

Next

End Function
 

Function HexStrToDecStr(strSid)

' Function to convert Hex string Sid to Decimal string (SDDL) Sid.
 
 

' SID anatomy:

' Byte Position

' 0 : SID Structure Revision Level (SRL)

' 1 : Number of Subauthority/Relative Identifier

' 2-7 : Identifier Authority Value (IAV) [48 bits]

' 8-x : Variable number of Subauthority or Relative Identifier (RID) [32 bits]

'

' Example:

'

' <Domain/Machine>\Administrator

' Pos : 0 | 1 | 2 3 4 5 6 7 | 8 9 10 11 | 12 13 14 15 | 16 17 18 19 | 20 21 22 23 | 24 25 26 27

' Value: 01 | 05 | 00 00 00 00 00 05 | 15 00 00 00 | 06 4E 7D 7F | 11 57 56 7A | 04 11 C5 20 | F4 01 00 00

' str : S- 1 | | -5 | -21 | -2138918406 | -2052478737 | -549785860 | -500
 
 

Const BYTES_IN_32BITS = 4

Const SRL_BYTE = 0

Const IAV_START_BYTE = 2

Const IAV_END_BYTE = 7

Const RID_START_BYTE = 8

Const MSB = 3 'Most significant byte

Const LSB = 0 'Least significant byte
 
 

Dim arrbytSid, lngTemp, base, offset, i
 
 

ReDim arrbytSid(Len(strSid)/2 - 1)
 
 

' Convert hex string into integer array

For i = 0 To UBound(arrbytSid)

      arrbytSid(i) = CInt("&H" & Mid(strSid, 2 * i + 1, 2))

Next
 
 

' Add SRL number

HexStrToDecStr = "S-" & arrbytSid(SRL_BYTE)
 
 

' Add Identifier Authority Value

lngTemp = 0

For i = IAV_START_BYTE To IAV_END_BYTE

      lngTemp = lngTemp * 256 + arrbytSid(i)

Next

HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
 
 

' Add a variable number of 32-bit subauthority or

' relative identifier (RID) values.

' Bytes are in reverse significant order.

' i.e. HEX 01 02 03 04 => HEX 04 03 02 01

' = (((0 * 256 + 04) * 256 + 03) * 256 + 02) * 256 + 01

' = DEC 67305985

For base = RID_START_BYTE To UBound(arrbytSid) Step BYTES_IN_32BITS

      lngTemp = 0

      For offset = MSB to LSB Step -1

            lngTemp = lngTemp * 256 + arrbytSid(base + offset)

      Next

      HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)

Next

End Function ' HexStrToDecStr

'=========================

Open in new window

0
Comment
Question by:bsharath
  • 30
  • 17
  • +1
49 Comments
 
LVL 5

Expert Comment

by:zabu99
Comment Utility
That's a heck of a script, hats off to Rob.

Just add in a line 58:
strManager = Trim(objExcel.ActiveSheet.Cells(intRow, "S").Value)

And then after line 117 add :
If strManager <> "" Then objNewUser.Put "manager", strManager

This assumes that column "S" of your spreadsheet has the manager information, otherwise change it.

That should do the trick.
0
 
LVL 50

Expert Comment

by:Dave Brett
Comment Utility
> That's a heck of a script, hats off to Rob.
Indeed. Great coding Rob

Cheers

Dave
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I get this error.

C:\Create users and contacts.vbs(118, 19) (null): A constraint violation occurred.
And this some times
C:\Create users and contacts.vbs(122, 19) (null): There is no such object on the server.

In the excel in colum S. row 1 i have "Manager" mentioned as the header
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I get this error.

C:\Create users and contacts.vbs(118, 19) (null): A constraint violation occurred.
And this some times
C:\Create users and contacts.vbs(122, 19) (null): There is no such object on the server.

In the excel in colum S. row 1 i have "Manager" mentioned as the header
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Hi guys, thanks for the comments...much appreciated....

The contraint violation occurs because the manager field requires a full distinguished name of an AD user, not just the display name that is placed in column S.

Change this line:
If strManager <> "" Then objNewUser.Put "manager", strManager

to this

                  If strManager <> "" Then
                        strManagerADsPath = Get_LDAP_User_Properties("user", "cn", strManager, "distinguishedName")
                        If InStr(strManagerADsPath, "LDAP://") > 0 Then
                              objNewUser.Put "manager", strManagerADsPath
                        Else
                              MsgBox "Unable to find distinguished name for manager: " & strManager
                        End If
                  End If


and that should find the distinguished name for that manager, and add that to the manager field.

Regards,

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Thank U Rob...
I cannot find this line in the script...
If strManager <> "" Then objNewUser.Put "manager", strManager
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Thank U Rob...
I cannot find this line in the script...
If strManager <> "" Then objNewUser.Put "manager", strManager
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Oh, I thought zabu advised to put that line under this one:
                  If strHomePhone <> "" Then objNewUser.Put "homePhone", strHomePhone

Follow zazu's instructions, but replace his line above, with my code.

Regards,

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Ok... When i run the script i get this
---------------------------

---------------------------
Unable to find distinguished name for manager: Benb
---------------------------
OK  
---------------------------

I tried the full name and the NTlogin for both got the same message...
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Ok... When i run the script i get this
---------------------------

---------------------------
Unable to find distinguished name for manager: Benb
---------------------------
OK  
---------------------------

I tried the full name and the NTlogin for both got the same message...
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Oh yeah! Ooops! I just realised I'm only returning the distinguishedName, which doesn't have LDAP:// in it....

Use this instead:

                  If strManager <> "" Then
                        strManagerADsPath = Get_LDAP_User_Properties("user", "cn", strManager, "distinguishedName")
                        If InStr(strManagerADsPath, "CN=") > 0 Then
                              objNewUser.Put "manager", strManagerADsPath
                        Else
                              MsgBox "Unable to find distinguished name for manager: " & strManager
                        End If
                  End If


Regards,

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Still get the same message Rob...
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Still get the same message Rob...
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
With the full name in column S?

Try the NT Login in column S and change this line
                        strManagerADsPath = Get_LDAP_User_Properties("user", "cn", strManager, "distinguishedName")

to this
                        strManagerADsPath = Get_LDAP_User_Properties("user", "samAccountName", strManager, "distinguishedName")

Regards,

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Sorry Rob still get the same message.
In Colum S i have the NTlogin of the manager.
The user gets created and the contact but manager does not get added.

Should the headers be of any specific type in the excel.?
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Sorry Rob still get the same message.
In Colum S i have the NTlogin of the manager.
The user gets created and the contact but manager does not get added.

Should the headers be of any specific type in the excel.?
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Hmmm. Odd.

After this line:
                        strManagerADsPath = Get_LDAP_User_Properties("user", "samAccountName", strManager, "distinguishedName")

can you put
MsgBox "Distinguished Name of " & strManager & " is: " & strManagerADsPath

Regards,

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I get 2 boxes as

---------------------------

---------------------------
Distinguished Name of biinb is:
---------------------------
OK  
---------------------------

Then this

---------------------------

---------------------------
Unable to find distinguished name for manager: biinb
---------------------------
OK  
---------------------------
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I get 2 boxes as

---------------------------

---------------------------
Distinguished Name of biinb is:
---------------------------
OK  
---------------------------

Then this

---------------------------

---------------------------
Unable to find distinguished name for manager: biinb
---------------------------
OK  
---------------------------
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
OK, I finally got some time to test it.  Make sure you have the CN (usually the same as the display name) in Column S for the Manager....

Regards,

Rob.
'====================

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

	strPath = Wscript.ScriptFullName

	strCommand = "%comspec% /k cscript  """ & strPath & """"

	Set objShell = CreateObject("Wscript.Shell")

	objShell.Run(strCommand), 1, True

	Wscript.Quit

End If
 

' Bind to Active Directory.

Set objRootLDAP = GetObject("LDAP://rootDSE")

 

' CONFIGURATION PARAMETERS FOR THE SCRIPT

' ******** USERS *************

strExcelFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Users_and_Contacts_Sharath.xls"

 

strUserOUPath = "OU=CS,OU=External users,OU=User Accounts,OU=IND,OU=Countries," & objRootLDAP.Get("defaultNamingContext")

strPassword = "abc123"

' ******** CONTACTS *************

 

strContactOUPath = "OU=CS,OU=contacts,OU=User Accounts,OU=IND,OU=Countries," & objRootLDAP.Get("defaultNamingContext")

' END CONFIGURATION PARAMETERS
 

Const xlUp = -4162

Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000

Const ADS_PROPERTY_CLEAR = 1

Const ADS_PROPERTY_UPDATE = 2

Const ADS_PROPERTY_APPEND = 3

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

objExcel.Workbooks.Open strExcelFile
 

Set objNetwork = CreateObject("WScript.Network")

strDomainName = objNetwork.UserDomain
 

For intRow = 2 To objExcel.ActiveSheet.Cells(65536, "A").End(xlUp).Row
 

	strFirstName = Trim(objExcel.ActiveSheet.Cells(intRow, "A").Value)

	strLastName = Trim(objExcel.ActiveSheet.Cells(intRow, "B").Value)

	strFullName = Trim(objExcel.ActiveSheet.Cells(intRow, "C").Value)

	strUserNameHeading = Mid(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), InStr(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), "@"),Len(Trim(objExcel.ActiveSheet.Cells(1, "D").Value)) - InStr(Trim(objExcel.ActiveSheet.Cells(1, "D").Value), "@"))

	strUserName = Trim(objExcel.ActiveSheet.Cells(intRow, "D").Value) & strUserNameHeading

	strEmail = Trim(objExcel.ActiveSheet.Cells(intRow, "E").Value)

	strGroups = Trim(objExcel.ActiveSheet.Cells(intRow, "F").Value)

	strDescription = Trim(objExcel.ActiveSheet.Cells(intRow, "G").Value)

	strAlias = strFirstName & strLastName

	strOffice = Trim(objExcel.ActiveSheet.Cells(intRow, "H").Value)

	strMobile = Trim(objExcel.ActiveSheet.Cells(intRow, "I").Value)

	strTitle = Trim(objExcel.ActiveSheet.Cells(intRow, "J").Value)

	strDepartment = Trim(objExcel.ActiveSheet.Cells(intRow, "K").Value)

	strCompany = Trim(objExcel.ActiveSheet.Cells(intRow, "L").Value)

	strAddress = Trim(objExcel.ActiveSheet.Cells(intRow, "M").Value)

	strCity = Trim(objExcel.ActiveSheet.Cells(intRow, "N").Value)

	strState = Trim(objExcel.ActiveSheet.Cells(intRow, "O").Value)

	strZipCode = Trim(objExcel.ActiveSheet.Cells(intRow, "P").Value)

	strCountry = Trim(objExcel.ActiveSheet.Cells(intRow, "Q").Value)

	strHomePhone = Trim(objExcel.ActiveSheet.Cells(intRow, "R").Value)

	strManager = Trim(objExcel.ActiveSheet.Cells(intRow, "S").Value)

	

	'strFirstName = Trim(Left(strFullName, InStrRev(strFullName, " ") - 1))

	'strLastName = Trim(Mid(strFullName, InStrRev(strFullName, " ") + 1))

	      

	If strFullName <> "" And strUserName <> "" Then

            

		WScript.Echo "About to create:" & VbCrLf &_

			strFullName & VbCrLf &_

			strFirstName & VbCrLf &_

			strLastName & VbCrLf & _

			strUserName & VbCrLf &_

			strPassword & VbCrLf &_

			"LDAP://" & strUserOUPath

                  

		' This will add the user to eg. Domain.Local\Users

		Set objContainer = GetObject("LDAP://" & strUserOUPath) 

		

		' Check if the user already exists

		On Error Resume Next

		

		Set objNewUser = GetObject("LDAP://cn=" & strFullName & "," & strUserOUPath)

		If Err.Number = 0 Then

			WScript.Echo "User " & strFullName & " already exists."

			On Error GoTo 0

		Else

			Err.Clear

			On Error GoTo 0

			

			' Build the actual User.

			' Attributes listed here: http://support.microsoft.com/kb/555638

			Set objNewUser = objContainer.Create("User", "cn= " & strFullName)

			'objNewUser.Put "userPrincipalName", strUserName & "@" & Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")

			If InStr(strUserName, "@") > 0 Then

				arrDomUserName = Split(strUserName, "@")

				strUserName = arrDomUserName(0)

				strSuffix = arrDomUserName(1)

			Else

				strUserName = strUserName

				strSuffix = Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")

			End If

			objNewUser.Put "userPrincipalName", strUserName & "@" & strSuffix

			objNewUser.Put "sAMAccountName", strUserName

			objNewUser.Put "givenName", strFirstName

			objNewUser.Put "sn", strLastName

			objNewUser.Put "displayName", strFullName

			'If strEmail <> "" Then objNewUser.Put "mail", strEmail

			If strDescription <> "" Then objNewUser.Put "description", strDescription

			If strOffice <> "" Then objNewUser.Put "physicalDeliveryOfficeName", strOffice

			If strMobile <> "" Then objNewUser.Put "mobile", strMobile

			If strTitle <> "" Then objNewUser.Put "title", strTitle

			If strDepartment <> "" Then objNewUser.Put "department", strDepartment

			If strCompany <> "" Then objNewUser.Put "company", strCompany

			If strAddress <> "" Then objNewUser.Put "streetAddress", strAddress

			If strCity <> "" Then objNewUser.Put "l", strCity

			If strState <> "" Then objNewUser.Put "st", strState

			If strZipCode <> "" Then objNewUser.Put "postalCode", strZipCode

			' ISO Country Code list: http://www.iso.org/iso/english_country_names_and_code_elements

			If strCountry <> "" Then objNewUser.Put "c", strCountry

			If strHomePhone <> "" Then objNewUser.Put "homePhone", strHomePhone

			If strManager <> "" Then

				strManagerADsPath = Get_LDAP_User_Properties("user", "cn", strManager, "distinguishedName")

				If InStr(strManagerADsPath, "CN=") > 0 Then

					objNewUser.Put "manager", strManagerADsPath

				Else

					WScript.Echo VbCrLf & "ERROR: Unable to find distinguished name for manager: " & strManager & VbCrLf

				End If

			End If

			objNewUser.SetInfo

			objNewUser.SetPassword strPassword

			objNewUser.AccountDisabled = False

			objNewUser.SetInfo

			

			intUserAccountControl = objNewUser.Get("userAccountControl") 

			If Not objNewUser.userAccountControl AND ADS_UF_DONT_EXPIRE_PASSWD Then

				objNewUser.Put "userAccountControl", objNewUser.userAccountControl XOR ADS_UF_DONT_EXPIRE_PASSWD

				objNewUser.SetInfo

			End If

                

			If strGroups <> "" Then

				arrGroups = Split(strGroups, ":")

				For Each strGroupName In arrGroups

					strGroupPath = Get_LDAP_User_Properties("group", "cn", strGroupName, "adsPath")

					If strGroupPath <> "" Then

						Set objGroup = GetObject(strGroupPath)

						On Error Resume Next

						objGroup.Add objNewUser.AdsPath

						If Err.Number <> 0 Then

							WScript.Echo Err.Number & ": " & Err.Description & " - cannot add " & objNewUser.AdsPath & " to " & objGroup.adspath

							Err.Clear

							boolUserAdded = False

							arrSid = objNewUser.objectSid

							strSidHex = OctetToHexStr(arrSid)

							strSidDec = HexStrToDecStr(strSidHex)

							objGroup.Add "LDAP://<SID=" & strSidDec & ">"

							If Err.Number <> 0 Then

								WScript.Echo Err.Number & ": " & Err.Description & " - cannot add " & strSidDec & " to " & objGroup.adspath

								Err.Clear

								boolUserAdded = False

								objGroup.Add "LDAP://CN=" & strSidDec & ",CN=ForeignSecurityPrincipals," & Mid(objNewUser.AdsPath, InStr(objNewUser.AdsPath, "DC="))

								If Err.Number <> 0 Then

									WScript.Echo Err.Number & ": " & Err.Description & " - cannot add LDAP://CN=" & strSidDec & ",CN=ForeignSecurityPrincipals," & Mid(objNewUser.AdsPath, InStr(objNewUser.AdsPath, "DC=")) & " to " & objGroup.adspath

									Err.Clear

									boolUserAdded = False

								Else

									boolUserAdded = True

								End If

							Else

								boolUserAdded = True

							End If

						Else

							boolUserAdded = True

						End If

						On Error GoTo 0

						If boolUserAdded = True Then

							WScript.Echo "User " & strUserName & " was added to the group " & objGroup.AdsPath

						Else

							WScript.Echo "Could not add user " & strUserName & " to the group " & strGroupName

						End If

						Set objGroup = Nothing

					Else

						WScript.Echo "Could not locate the group " & strGroupName & " to add the user " & objNewUser.samAccountName & " to."

					End If

				Next

			End If

		End If

		

		' ********** CONTACT CREATION *************

		Set objContactsContainer = GetObject("LDAP://" & strContactOUPath)

		

		' Check if the contact already exists

		On Error Resume Next

		

		Set objNewContact = GetObject("LDAP://cn=" & strFullName & "," & strContactOUPath)

		If Err.Number = 0 Then

			WScript.Echo "Contact " & strFullName & " already exists."

			On Error GoTo 0

		Else

			Err.Clear

			On Error GoTo 0
 

			' Build the actual Contact.

			Set objContact = objContactsContainer.Create("Contact","cn=" & strFullName)

			'objContact.Put "Mail", strEmail

			objContact.Put "givenName", strFirstName

			objContact.Put "sn", strLastName

			objContact.Put "displayName", strFullName

			objContact.Put "mailNickname", Cstr(strAlias)

			objContact.Put "targetAddress", "SMTP:" & strEmail

			On Error Resume Next

			objGroup.PutEx ADS_PROPERTY_CLEAR, "proxyAddresses", 0

			objContact.SetInfo

			On Error GoTo 0

			objContact.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("SMTP:" & strEmail,"SMTP:" & strAlias & "@" & Mid(Replace(objRootLDAP.Get("defaultNamingContext"), "DC=", "."), 2))

			objContact.SetInfo

			If strOffice <> "" Then objContact.Put "physicalDeliveryOfficeName", strOffice

			If strDescription <> "" Then objContact.Put "description", strDescription

			If strMobile <> "" Then objContact.Put "mobile", strMobile

			If strTitle <> "" Then objContact.Put "title", strTitle

			If strDepartment <> "" Then objContact.Put "department", strDepartment

			If strCompany <> "" Then objContact.Put "company", strCompany

			If strAddress <> "" Then objContact.Put "streetAddress", strAddress

			If strCity <> "" Then objContact.Put "l", strCity

			If strState <> "" Then objContact.Put "st", strState

			If strZipCode <> "" Then objContact.Put "postalCode", strZipCode

			' ISO Country Code list: http://www.iso.org/iso/english_country_names_and_code_elements

			If strCountry <> "" Then objContact.Put "c", strCountry

			If strHomePhone <> "" Then objContact.Put "homePhone", strHomePhone

			If strManager <> "" Then

				strManagerADsPath = Get_LDAP_User_Properties("user", "cn", strManager, "distinguishedName")

				If InStr(strManagerADsPath, "CN=") > 0 Then

					objContact.Put "manager", strManagerADsPath

				Else

					WScript.Echo VbCrLf & "ERROR: Unable to find distinguished name for manager: " & strManager & VbCrLf

				End If

			End If

                  

			objContact.SetInfo

			WScript.Echo "Contact " & strAlias & " created."

		End If

	End If

Next
 

WScript.Echo "Done"

objExcel.ActiveWorkbook.Close False

objExcel.Quit

Set objExcel = Nothing
 

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

      

      If InStr(strObjectToGet, "\") > 0 Then

            arrGroupBits = Split(strObjectToGet, "\")

            strDC = arrGroupBits(0)

            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")

            strObjectToGet = arrGroupBits(1)

      Else

            Set objRootDSE = GetObject("LDAP://RootDSE")

            'strDNSDomain = objRootDSE.Get("defaultNamingContext")

            strDNSDomain = objRootDSE.Get("RootDomainNamingContext")

      End If
 

      strBase = "<LDAP://" & strDNSDomain & ">"

      ' Setup ADO objects.

      Set adoCommand = CreateObject("ADODB.Command")

      Set adoConnection = CreateObject("ADODB.Connection")

      adoConnection.Provider = "ADsDSOObject"

      adoConnection.Open "Active Directory Provider"

      adoCommand.ActiveConnection = adoConnection
 

 

      ' Filter on user objects.

      'strFilter = "(&(objectCategory=person)(objectClass=user))"

      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
 

      ' Comma delimited list of attribute values to retrieve.

      strAttributes = strCommaDelimProps

      arrProperties = Split(strCommaDelimProps, ",")
 

      ' Construct the LDAP syntax query.

      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

      adoCommand.CommandText = strQuery

      adoCommand.Properties("Page Size") = 100

      adoCommand.Properties("Timeout") = 30

      adoCommand.Properties("Cache Results") = False
 

      ' Run the query.

      On Error Resume Next

      Set adoRecordset = adoCommand.Execute

      If Err.Number = 0 Then

	      On Error GoTo 0

	      ' Enumerate the resulting recordset.

	      Do Until adoRecordset.EOF

	          ' Retrieve values and display.    

	          For intCount = LBound(arrProperties) To UBound(arrProperties)

	                If strDetails = "" Then

	                      strDetails = adoRecordset.Fields(intCount).Value

	                Else

	                      strDetails = strDetails & VbCrLf & adoRecordset.Fields(intCount).Value

	                End If

	          Next

	          ' Move to the next record in the recordset.

	          adoRecordset.MoveNext

	      Loop

	

	      ' Clean up.

	      adoRecordset.Close

	  Else

	  	Err.Clear

	  	On Error GoTo 0

		strDetails = ""

	  End If

      adoConnection.Close

      If InStr(strDNSDomain, "/") > 0 Then

      	Get_LDAP_User_Properties = Replace(strDetails, Left(strDNSDomain, InStr(strDNSDomain, "/")), "")

      Else

      	Get_LDAP_User_Properties = strDetails

      End If
 

End Function
 

'Working VBScript Active Directory Binary SID conversion to String SID

' Source: http://forums.techarena.in/showthread.php?t=588078

'Function to convert OctetString (byte array) to Hex string.

Function OctetToHexStr(arrbytOctet)

Dim k

OctetToHexStr = ""

For k = 1 To Lenb(arrbytOctet)

OctetToHexStr = OctetToHexStr & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)

Next

End Function
 

Function HexStrToDecStr(strSid)

' Function to convert Hex string Sid to Decimal string (SDDL) Sid.
 
 

' SID anatomy:

' Byte Position

' 0 : SID Structure Revision Level (SRL)

' 1 : Number of Subauthority/Relative Identifier

' 2-7 : Identifier Authority Value (IAV) [48 bits]

' 8-x : Variable number of Subauthority or Relative Identifier (RID) [32 bits]

'

' Example:

'

' <Domain/Machine>\Administrator

' Pos : 0 | 1 | 2 3 4 5 6 7 | 8 9 10 11 | 12 13 14 15 | 16 17 18 19 | 20 21 22 23 | 24 25 26 27

' Value: 01 | 05 | 00 00 00 00 00 05 | 15 00 00 00 | 06 4E 7D 7F | 11 57 56 7A | 04 11 C5 20 | F4 01 00 00

' str : S- 1 | | -5 | -21 | -2138918406 | -2052478737 | -549785860 | -500
 
 

Const BYTES_IN_32BITS = 4

Const SRL_BYTE = 0

Const IAV_START_BYTE = 2

Const IAV_END_BYTE = 7

Const RID_START_BYTE = 8

Const MSB = 3 'Most significant byte

Const LSB = 0 'Least significant byte
 
 

Dim arrbytSid, lngTemp, base, offset, i
 
 

ReDim arrbytSid(Len(strSid)/2 - 1)
 
 

' Convert hex string into integer array

For i = 0 To UBound(arrbytSid)

      arrbytSid(i) = CInt("&H" & Mid(strSid, 2 * i + 1, 2))

Next
 
 

' Add SRL number

HexStrToDecStr = "S-" & arrbytSid(SRL_BYTE)
 
 

' Add Identifier Authority Value

lngTemp = 0

For i = IAV_START_BYTE To IAV_END_BYTE

      lngTemp = lngTemp * 256 + arrbytSid(i)

Next

HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
 
 

' Add a variable number of 32-bit subauthority or

' relative identifier (RID) values.

' Bytes are in reverse significant order.

' i.e. HEX 01 02 03 04 => HEX 04 03 02 01

' = (((0 * 256 + 04) * 256 + 03) * 256 + 02) * 256 + 01

' = DEC 67305985

For base = RID_START_BYTE To UBound(arrbytSid) Step BYTES_IN_32BITS

      lngTemp = 0

      For offset = MSB to LSB Step -1

            lngTemp = lngTemp * 256 + arrbytSid(base + offset)

      Next

      HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)

Next

End Function ' HexStrToDecStr

'=========================

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I get this

ERROR: Unable to find distinguished name for manager: biinb


ERROR: Unable to find distinguished name for manager: biinb

Contact ShaBaa created.
Done
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I get this

ERROR: Unable to find distinguished name for manager: biinb


ERROR: Unable to find distinguished name for manager: biinb

Contact ShaBaa created.
Done
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Is biinb the Display Name ([First Name] [Last Name])?  That seems like a login name....
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
No thats the NT login...
I even tried with Full Name,First name & Nt login for all these 3 i get the same message...
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 11

Author Comment

by:bsharath
Comment Utility
No thats the NT login...
I even tried with Full Name,First name & Nt login for all these 3 i get the same message...
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
The way the code is, it searches for the manager by the full name from column S.

Is the manager you are trying to search located in the same domain?

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Yes in the same domain.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Yes in the same domain.
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
OK, can you try just this VBS file, which does the same thing, searching for the manager, by full name.  It's just that this way, you can test the search without doing anything else.

Regards,

Rob.
strManager = InputBox("Enter a manager's full name:", "Full Name")

If strManager <> "" Then

	strManagerADsPath = Get_LDAP_User_Properties("user", "cn", strManager, "distinguishedName")

	If InStr(strManagerADsPath, "CN=") > 0 Then

		'objContact.Put "manager", strManagerADsPath

		WScript.Echo VbCrLf & "Distinguished Name for " & strManager & ":" & VbCrLf & strManagerADsPath

	Else

		WScript.Echo VbCrLf & "ERROR: Unable to find distinguished name for manager: " & strManager & VbCrLf

	End If

End If
 
 

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

      

      If InStr(strObjectToGet, "\") > 0 Then

            arrGroupBits = Split(strObjectToGet, "\")

            strDC = arrGroupBits(0)

            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")

            strObjectToGet = arrGroupBits(1)

      Else

            Set objRootDSE = GetObject("LDAP://RootDSE")

            'strDNSDomain = objRootDSE.Get("defaultNamingContext")

            strDNSDomain = objRootDSE.Get("RootDomainNamingContext")

      End If

 

      strBase = "<LDAP://" & strDNSDomain & ">"

      ' Setup ADO objects.

      Set adoCommand = CreateObject("ADODB.Command")

      Set adoConnection = CreateObject("ADODB.Connection")

      adoConnection.Provider = "ADsDSOObject"

      adoConnection.Open "Active Directory Provider"

      adoCommand.ActiveConnection = adoConnection

 

 

      ' Filter on user objects.

      'strFilter = "(&(objectCategory=person)(objectClass=user))"

      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"

 

      ' Comma delimited list of attribute values to retrieve.

      strAttributes = strCommaDelimProps

      arrProperties = Split(strCommaDelimProps, ",")

 

      ' Construct the LDAP syntax query.

      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

      adoCommand.CommandText = strQuery

      adoCommand.Properties("Page Size") = 100

      adoCommand.Properties("Timeout") = 30

      adoCommand.Properties("Cache Results") = False

 

      ' Run the query.

      On Error Resume Next

      Set adoRecordset = adoCommand.Execute

      If Err.Number = 0 Then

	      On Error GoTo 0

	      ' Enumerate the resulting recordset.

	      Do Until adoRecordset.EOF

	          ' Retrieve values and display.    

	          For intCount = LBound(arrProperties) To UBound(arrProperties)

	                If strDetails = "" Then

	                      strDetails = adoRecordset.Fields(intCount).Value

	                Else

	                      strDetails = strDetails & VbCrLf & adoRecordset.Fields(intCount).Value

	                End If

	          Next

	          ' Move to the next record in the recordset.

	          adoRecordset.MoveNext

	      Loop

	

	      ' Clean up.

	      adoRecordset.Close

	  Else

	  	Err.Clear

	  	On Error GoTo 0

		strDetails = ""

	  End If

      adoConnection.Close

      If InStr(strDNSDomain, "/") > 0 Then

      	Get_LDAP_User_Properties = Replace(strDetails, Left(strDNSDomain, InStr(strDNSDomain, "/")), "")

      Else

      	Get_LDAP_User_Properties = strDetails

      End If

 

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I dont know why but it does not get the results says cannot find for any name i mention....
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I dont know why but it does not get the results says cannot find for any name i mention....
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Under this line:
      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

please put this:
      strQuery = InputBox("The query to be run is:", "Query", strQuery)

and paste the query string....

Regards,

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I get this

<LDAP://DC=Group,DC=co,DC=uk>;(&(objectClass=user)(cn=biin bari));distinguishedName;subtree
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I get this

<LDAP://DC=Group,DC=co,DC=uk>;(&(objectClass=user)(cn=biin bari));distinguishedName;subtree
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
There should be no problem with that at all.....so "biin bari" is the person's full name?

Are you running with administrative rights to the domain?

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Yes thats the full name and yes i am running from a Domain Admin account.
But the users are in the Development Domain i thinks the script is checking the root Domain... Just a thought not sure...
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Yes thats the full name and yes i am running from a Domain Admin account.
But the users are in the Development Domain i thinks the script is checking the root Domain... Just a thought not sure...
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Right....so in the manager's name box, try putting
development.group.co.uk\biin bari

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Still get not found

<LDAP://development.group.co.uk/DC=group,DC=co,DC=uk>;(&(objectClass=user)(cn=biin bari));distinguishedName;subtree
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Still get not found

<LDAP://development.group.co.uk/DC=group,DC=co,DC=uk>;(&(objectClass=user)(cn=biin bari));distinguishedName;subtree
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Ah, that's right....it needs a DC name for that domain....try putting
DCNAME.development.group.co.uk\biin bari

Regards,

Rob.
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Or, I forgot about GC instead of LDAP.....try this.....
strManager = InputBox("Enter a manager's full name:", "Full Name")

If strManager <> "" Then

	strManagerADsPath = Get_LDAP_User_Properties("user", "cn", strManager, "distinguishedName")

	If InStr(strManagerADsPath, "CN=") > 0 Then

		'objContact.Put "manager", strManagerADsPath

		WScript.Echo VbCrLf & "Distinguished Name for " & strManager & ":" & VbCrLf & strManagerADsPath

	Else

		WScript.Echo VbCrLf & "ERROR: Unable to find distinguished name for manager: " & strManager & VbCrLf

	End If

End If
 
 

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

      

      If InStr(strObjectToGet, "\") > 0 Then

            arrGroupBits = Split(strObjectToGet, "\")

            strDC = arrGroupBits(0)

            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")

            strObjectToGet = arrGroupBits(1)

      Else

            Set objRootDSE = GetObject("GC://RootDSE")

            'strDNSDomain = objRootDSE.Get("defaultNamingContext")

            strDNSDomain = objRootDSE.Get("RootDomainNamingContext")

      End If

 

      strBase = "<GC://" & strDNSDomain & ">"

      ' Setup ADO objects.

      Set adoCommand = CreateObject("ADODB.Command")

      Set adoConnection = CreateObject("ADODB.Connection")

      adoConnection.Provider = "ADsDSOObject"

      adoConnection.Open "Active Directory Provider"

      adoCommand.ActiveConnection = adoConnection

 

 

      ' Filter on user objects.

      'strFilter = "(&(objectCategory=person)(objectClass=user))"

      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"

 

      ' Comma delimited list of attribute values to retrieve.

      strAttributes = strCommaDelimProps

      arrProperties = Split(strCommaDelimProps, ",")

 

      ' Construct the LDAP syntax query.

      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

      adoCommand.CommandText = strQuery

      adoCommand.Properties("Page Size") = 100

      adoCommand.Properties("Timeout") = 30

      adoCommand.Properties("Cache Results") = False

 

      ' Run the query.

      On Error Resume Next

      Set adoRecordset = adoCommand.Execute

      If Err.Number = 0 Then

	      On Error GoTo 0

	      ' Enumerate the resulting recordset.

	      Do Until adoRecordset.EOF

	          ' Retrieve values and display.    

	          For intCount = LBound(arrProperties) To UBound(arrProperties)

	                If strDetails = "" Then

	                      strDetails = adoRecordset.Fields(intCount).Value

	                Else

	                      strDetails = strDetails & VbCrLf & adoRecordset.Fields(intCount).Value

	                End If

	          Next

	          ' Move to the next record in the recordset.

	          adoRecordset.MoveNext

	      Loop

	

	      ' Clean up.

	      adoRecordset.Close

	  Else

	  	Err.Clear

	  	On Error GoTo 0

		strDetails = ""

	  End If

      adoConnection.Close

      If InStr(strDNSDomain, "/") > 0 Then

      	Get_LDAP_User_Properties = Replace(strDetails, Left(strDNSDomain, InStr(strDNSDomain, "/")), "")

      Else

      	Get_LDAP_User_Properties = strDetails

      End If

 

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Now i get it... Its shows the path right...
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Now i get it... Its shows the path right...
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
OK, so specifying the DC and full domain path works....does the GC change above work when you specify only the full name?

Regards,

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I did no changes to this scripr "ID: 22847875" just mentioned the same name and it showed the Ou path....
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Yeah, but if the GC code from ID: 22847875 works with only the full name (not the domain controller and domain suffix), then that would save you having to write them all....

Regards,

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
I did no changes but just ran your script and put the manager name into the popup...
I did not mention any DC or suffix
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
Comment Utility
>> I did no changes but just ran your script and put the manager name into the popup...
I did not mention any DC or suffix

So did that return the correct LDAP path when you used the GC code from ID: 22847875 and only entered the full name?

If that did work, go back to the code in ID: 22838375, and look at the code on lines 254 and 259.  Change each instance of LDAP:// on those lines, to GC://

Regards,

Rob.
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

This script will sweep a range of IP addresses (class c only, 255.255.255.0) and report to a log the version of office installed. What it does: 1.)      Creates log file in the directory the script is run from (if it doesn't already exist) 2.)      Sweep…
Batch, VBS, and scripts in general are incredibly useful for repetitive tasks.  Some tasks can take a while to complete and it can be annoying to check back only to discover that your script finished 5 minutes ago.  Some scripts may complete nearly …
The viewer will learn how to create and use a small PHP class to apply a watermark to an image. This video shows the viewer the setup for the PHP watermark as well as important coding language. Continue to Part 2 to learn the core code used in creat…
The viewer will learn the basics of jQuery, including how to invoke it on a web page. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery.: (CODE)

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now