RE: [ActiveDir] Import Contacts into AD

Tue, 21 Dec 2004 02:26:20 -0800

Hello all

 

Below is the script I am using to import contacts. I am successful in doing so. But after few minutes all the email ([EMAIL PROTECTED])addresses of the contacts change to my email addresses([EMAIL PROTECTED]) I am surprised why this is happening. I am suscpecting that the default policy of exchange is changing the email domain address.

Anyone has bulk imported external contacts into AD. Please forward the information or script. I will thank you all in advance.

 

 

 

Option Explicit

 

Dim objExcel, strExcelPath, objSheet

Dim strLast, strFirst, strMiddle, strDisplay, intRow, intCol

Dim strGroupDN, objUser, objGroup, objContainer

Dim strCN, strNTName, strContainerDN

Dim strHomeFolder, strHomeDrive, objFSO, objShell

Dim intRunError, strNetBIOSDomain, strDNSDomain, objDomain

Dim objRootDSE, objTrans, strLogonScript, strUPN

Dim strDepartment, strOffice,  strDescription, strPhone

Dim strMail, strMailAlias

 

 

' Specify spreadsheet.

strExcelPath = "d:\MYSCRIPTS\contacts2.xls"

 

' Specify DN of container where contacts created.

strContainerDN = "OU=CONTACTS"

 

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objShell = CreateObject("Wscript.Shell")

 

' Determine DNS domain name from RootDSE object.

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

strDNSDomain = objRootDSE.Get("DefaultNamingContext")

Set objDomain = GetObject("LDAP://" & strDNSDomain)

 

 

' Open spreadsheet.

Set objExcel = CreateObject("Excel.Application")

 

'On Error Resume Next

objExcel.Workbooks.Open strExcelPath

 

If Err.Number <> 0 Then

  On Error GoTo 0

  Wscript.Echo "Unable to open spreadsheet " & strExcelPath

  Wscript.Quit

End If

On Error GoTo 0

 

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

 

' Bind to container where users to be created.

'On Error Resume Next

Set objContainer = GetObject("LDAP://" & strContainerDN & "," & strDNSDomain)

If Err.Number <> 0 Then

  On Error GoTo 0

  Wscript.Echo "Unable to bind to container: " & strContainerDN

  Wscript.Quit

End If

On Error GoTo 0

 

' Start with row 2 of spreadsheet.

' Assume first row has column headings.

intRow = 2

 

' Read each row of spreadsheet until a blank value

' encountered in column 1 (the column for cn).

' For each row, create CONTACT and set attribute values.

 

Do while objSheet.Cells(intRow, 1).Value <> ""

 

  ' Read values from spreadsheet for this user.

  strFirst = Trim(objSheet.Cells(intRow, 4).Value)

  strMiddle = Trim(objSheet.Cells(intRow, 5).Value)

  strLast = Trim(objSheet.Cells(intRow, 6).Value)

  strDisplay = Trim(objSheet.Cells(intRow, 3).Value)

  strCN = Trim(objSheet.Cells(intRow, 1).Value)

  strMail= Trim(objSheet.Cells(intRow,7).Value)

  strMailAlias = Trim(objSheet.Cells(intRow,8).Value)

  strDescription = Trim(objSheet.Cells(intRow,9).Value)

  strOffice = Trim(objSheet.Cells(intRow,10).Value)

  'strPhone = Trim(objSheet.Cells(intRow,11).Value)

  strDepartment = Trim(objSheet.Cells(intRow,12).Value)

 

  ' Create contact.

  'On Error Resume Next

  Set objUser = objContainer.Create("contact", "cn=" & strCN)

  If Err.Number <> 0 Then

    On Error GoTo 0

    Wscript.Echo "Unable to create contact with cn: " & strCN

  Else

    On Error GoTo 0

    ' Assign other attributes and save contact object.

   

      If strFirst <> "" Then

        objUser.givenName = strFirst

      End If

      ' Assign values to remaining attributes.

      If strMiddle <> "" Then

        objUser.initials = strMiddle

      End If

      If strLast <> "" Then

        objUser.sn = strLast

      End If

      If strDisplay <> "" Then

        objUser.displayName = strDisplay

      End If

      If strMail <> "" Then

        objUser.mail = strMail

      End If

      If strMailAlias <> "" Then

        objUser.mailNickname = strMailAlias

      End If

      If strDescription <> "" Then

        objUser.description = strDescription

      End If

      If strOffice <> "" Then

        objUser.physicalDeliveryOfficeName = strOffice

      End If

      'If strPhone <> "" Then

        'objUser.telephoneNumber = strPhone

      'End If

      If strDepartment <> "" Then

        objUser.department = strDepartment

      End If

     

     

      objUser.SetInfo

      If Err.Number <> 0 Then

        On Error GoTo 0

        Wscript.Echo "Unable to set attributes for contact with cn: " & strCN

      End If

     

End if

            

   

       

  ' Increment to next user.

  intRow = intRow + 1

Loop

 

Wscript.Echo "Import of Contacts Completed"

 

' Clean up.

objExcel.ActiveWorkbook.Close

objExcel.Application.Quit

Set objUser = Nothing

Set objGroup = Nothing

Set objContainer = Nothing

Set objSheet = Nothing

Set objExcel = Nothing

Set objFSO = Nothing

Set objShell = Nothing

Set objTrans = Nothing

Set objRootDSE = Nothing

 

 

-----Original Message-----
From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] On Behalf Of joe
Sent: Monday, December 20, 2004 5:11 PM
To: [email protected]
Subject: RE: [ActiveDir] Import Contacts into AD

 

Did you try to make these exchange enabled contacts? If so did you populate

the mail attribute or targetaddress? Sounds like the mail attribute.

 

  joe

 

 

 

-----Original Message-----

From: [EMAIL PROTECTED]

[mailto:[EMAIL PROTECTED] On Behalf Of Saleem, Mohamed

Yunus

Sent: Monday, December 20, 2004 6:39 AM

To: [email protected]

Subject: [ActiveDir] Import Contacts into AD

 

Hello People

 

I imported contacts into my AD using excel sheet containing 361 rows and 10

columns (details of all the users sent by admin from another domain)

 

What happened was after the import the email address of the contacts is not

the same as in the excel sheet sent by the admin, instead it changes back to

my domain email id.

 

Has anyone come across this situation, please help

 

If anyone has a script which does this..please forward it to me.

 

Thanks

 

saleem

 

 

List info   : http://www.activedir.org/mail_list.htm

List FAQ    : http://www.activedir.org/list_faq.htm

List archive: http://www.mail-archive.com/activedir%40mail.activedir.org/

 

List info   : http://www.activedir.org/mail_list.htm

List FAQ    : http://www.activedir.org/list_faq.htm

List archive: http://www.mail-archive.com/activedir%40mail.activedir.org/


Option Explicit

Dim objExcel, strExcelPath, objSheet
Dim strLast, strFirst, strMiddle, strDisplay, intRow, intCol
Dim strGroupDN, objUser, objGroup, objContainer
Dim strCN, strNTName, strContainerDN
Dim strHomeFolder, strHomeDrive, objFSO, objShell
Dim intRunError, strNetBIOSDomain, strDNSDomain, objDomain
Dim objRootDSE, objTrans, strLogonScript, strUPN
Dim strDepartment, strOffice,  strDescription, strPhone
Dim strMail, strMailAlias


' Specify spreadsheet.
strExcelPath = "d:\MYSCRIPTS\contacts2.xls"

' Specify DN of container where contacts created.
strContainerDN = "OU=CONTACTS"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")

' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE";)
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
Set objDomain = GetObject("LDAP://"; & strDNSDomain)


' Open spreadsheet.
Set objExcel = CreateObject("Excel.Application")

'On Error Resume Next
objExcel.Workbooks.Open strExcelPath

If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Unable to open spreadsheet " & strExcelPath
  Wscript.Quit
End If
On Error GoTo 0

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' Bind to container where users to be created.
'On Error Resume Next
Set objContainer = GetObject("LDAP://"; & strContainerDN & "," & strDNSDomain)
If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Unable to bind to container: " & strContainerDN
  Wscript.Quit
End If
On Error GoTo 0

' Start with row 2 of spreadsheet.
' Assume first row has column headings.
intRow = 2

' Read each row of spreadsheet until a blank value
' encountered in column 1 (the column for cn).
' For each row, create CONTACT and set attribute values.

Do while objSheet.Cells(intRow, 1).Value <> ""

  ' Read values from spreadsheet for this user.
  strFirst = Trim(objSheet.Cells(intRow, 4).Value)
  strMiddle = Trim(objSheet.Cells(intRow, 5).Value)
  strLast = Trim(objSheet.Cells(intRow, 6).Value)
  strDisplay = Trim(objSheet.Cells(intRow, 3).Value)
  strCN = Trim(objSheet.Cells(intRow, 1).Value)
  strMail= Trim(objSheet.Cells(intRow,7).Value)
  strMailAlias = Trim(objSheet.Cells(intRow,8).Value)
  strDescription = Trim(objSheet.Cells(intRow,9).Value)
  strOffice = Trim(objSheet.Cells(intRow,10).Value)
  'strPhone = Trim(objSheet.Cells(intRow,11).Value)
  strDepartment = Trim(objSheet.Cells(intRow,12).Value)
  
  ' Create contact.
  'On Error Resume Next
  Set objUser = objContainer.Create("contact", "cn=" & strCN)
  If Err.Number <> 0 Then
    On Error GoTo 0
    Wscript.Echo "Unable to create contact with cn: " & strCN
  Else
    On Error GoTo 0
    ' Assign other attributes and save contact object.
    
      If strFirst <> "" Then
        objUser.givenName = strFirst
      End If
      ' Assign values to remaining attributes.
      If strMiddle <> "" Then
        objUser.initials = strMiddle
      End If
      If strLast <> "" Then
        objUser.sn = strLast
      End If
      If strDisplay <> "" Then
        objUser.displayName = strDisplay
      End If
      If strMail <> "" Then
        objUser.mail = strMail
      End If
      If strMailAlias <> "" Then
        objUser.mailNickname = strMailAlias
      End If
      If strDescription <> "" Then
        objUser.description = strDescription
      End If
      If strOffice <> "" Then
        objUser.physicalDeliveryOfficeName = strOffice
      End If
      'If strPhone <> "" Then
        'objUser.telephoneNumber = strPhone
      'End If
      If strDepartment <> "" Then
        objUser.department = strDepartment
      End If
      
      
      objUser.SetInfo
      If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Unable to set attributes for contact with cn: " & strCN
      End If
      
End if 
             
    
        
  ' Increment to next user.
  intRow = intRow + 1
Loop

Wscript.Echo "Import of Contacts Completed"

' Clean up.
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
Set objUser = Nothing
Set objGroup = Nothing
Set objContainer = Nothing
Set objSheet = Nothing
Set objExcel = Nothing
Set objFSO = Nothing
Set objShell = Nothing
Set objTrans = Nothing
Set objRootDSE = Nothing

Reply via email to