Personally, I think I'd use a different method to create those contacts. CDOEXM was made for this sort of stuff.
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/e2k3/e2k3/_ cdo_imailrecipient_mailenable.asp Al -----Original Message----- From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] On Behalf Of Saleem, Mohamed Yunus Sent: Tuesday, December 21, 2004 5:23 AM To: [email protected] Subject: RE: [ActiveDir] Import Contacts into AD 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/ 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/
