?
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
Medium Priority
?
517 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 30
  • 17
  • +1
49 Comments
 
LVL 5

Expert Comment

by:zabu99
ID: 22800309
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
ID: 22805036
> That's a heck of a script, hats off to Rob.
Indeed. Great coding Rob

Cheers

Dave
0
 
LVL 11

Author Comment

by:bsharath
ID: 22819198
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
Get 15 Days FREE Full-Featured Trial

Benefit from a mission critical IT monitoring with Monitis Premium or get it FREE for your entry level monitoring needs.
-Over 200,000 users
-More than 300,000 websites monitored
-Used in 197 countries
-Recommended by 98% of users

 
LVL 11

Author Comment

by:bsharath
ID: 22819199
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
ID: 22837227
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
ID: 22837684
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
ID: 22837685
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
ID: 22837726
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
ID: 22837744
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
ID: 22837745
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
ID: 22837764
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
ID: 22837786
Still get the same message Rob...
0
 
LVL 11

Author Comment

by:bsharath
ID: 22837788
Still get the same message Rob...
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22837802
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
ID: 22837825
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
ID: 22837826
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
ID: 22837918
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
ID: 22837933
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
ID: 22837934
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
ID: 22838375
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
ID: 22838432
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
ID: 22838433
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
ID: 22838469
Is biinb the Display Name ([First Name] [Last Name])?  That seems like a login name....
0
 
LVL 11

Author Comment

by:bsharath
ID: 22838485
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 11

Author Comment

by:bsharath
ID: 22838486
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
ID: 22847569
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
ID: 22847595
Yes in the same domain.
0
 
LVL 11

Author Comment

by:bsharath
ID: 22847596
Yes in the same domain.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22847632
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
ID: 22847650
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
ID: 22847651
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
ID: 22847759
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
ID: 22847788
I get this

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

Author Comment

by:bsharath
ID: 22847789
I get this

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

Expert Comment

by:RobSampson
ID: 22847802
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
ID: 22847809
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
ID: 22847810
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
ID: 22847824
Right....so in the manager's name box, try putting
development.group.co.uk\biin bari

Rob.
0
 
LVL 11

Author Comment

by:bsharath
ID: 22847833
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
ID: 22847835
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
ID: 22847867
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
ID: 22847875
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
ID: 22847879
Now i get it... Its shows the path right...
0
 
LVL 11

Author Comment

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

Expert Comment

by:RobSampson
ID: 22847894
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
ID: 22847903
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
ID: 22847917
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
ID: 22847927
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 2000 total points
ID: 22864113
>> 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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
A quick Powershell script I wrote to find old program installations and check versions of a specific file across the network.
The goal of the tutorial is to teach the user how to use functions in C++. The video will cover how to define functions, how to call functions and how to create functions prototypes. Microsoft Visual C++ 2010 Express will be used as a text editor an…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…
Suggested Courses

800 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