На главную страницу
 
  Главная 
  Новости 
  Статьи  RSS
  Программное обеспечение 
  Форум 
  Опросы 
  Полезные ссылки 
MSExchange.ru ISADocs.ru WinSecurity.ru NetDocs.ru

Exchange 5.5
Exchange 2000
Exchange 2003
Exchange 2007
Общее
Exchange 2010

Поиск по сайту


Авторизация

Запомнить меня на этом компьютере
  Забыли свой пароль?
  Регистрация

Подписка

Изменение параметров

Статистика

Hits 27310659
4149
Hosts 2408432
184
Visitors 1883840
207

6

Главная / Статьи / Exchange 2000 / Перенос контактов и списков рассылок из Outlook в Active Directory


SurfCop

Перенос контактов и списков рассылок из Outlook в Active Directory

Версия для печати Версия для печати

Эта статья переведена силами и средствами компании Red Line Software. Размещение данного переведенного материала на других сайтах без разрешения компании Red Line Software запрещается.

Использование скрипта, преобразующего MAPI информации о контактах из Outlook в быстрейшую LDAP-реализацию, расширенную для нужд Exchange.

Введение

В статье Using Exchange 2000 as a low end contact management solution рассказано о способе использования Active Directory для хранения контактов. Расширенный под нужды Exchange, Active Directory предоставляет собой масштабируемые решения для хранения контактов, запрашиваемых средствами LDAP. Процесс получения контактов из Active Directory, даже большого количества, происходит очень быстро, что выгодно отличает его от использования стандартных Outlook контактов.

С другой стороны, обычные контакты Outlook очень легко использовать. Существует возможность импортировать их из множества источников с помощью мастера импорта-экспорта (Import and Export Wizard). Контакты из любого приложения, поддерживающего экспорт в текстовые файлы, могут быть импортированы в Outlook.

Хотя Active Directory и предоставляет утилиты для массового импорта информации (LDIFDE и CSVDE), тем не менее, это не самый лёгкий способ, на который не каждый может надеяться.

Я представлю вашему вниманию несколько полезных скриптов для переноса контактов из Outlook в Active Directory. Это выглядит как процесс из двух частей. Например, вам нужно перенести 70000 контактов из Outlook Express — сначала экспортируйте их, а потом используйте скрипт для переноса их в AD.

Скрипт для переноса контактов

Скрипт, написанный на VBScript, имеет следующие требования:

— Хранение контактов в общей папке (для изменения, поправьте переменную myfolder 'Set myfolder = myNameSpace.Folders');

— Изменение строки, начинающейся с , для того, чтобы objContainer указывал на существующий OU (Organization Unit), куда и будут перенесены контакты. Чтобы осуществить это, замените часть строки на DN вашего OU (используйте утилиту ADSIEdit для нахождения этого свойства)

Также, для правильной работы скрипта, необходим файл «contrycodes.csy», который можно скачать тут. Это позволит распознать страну контакта по её коду.

Скрипт просматривает все контакты в общей папке, проверяет наличие контакта в AD и, при его отсутствии, создаёт оный. Он просматривает все поля в контакте и, если они правильно созданы, переводит в эквивалентные поля AD.

При написании этого скрипта возникли некоторые проблемы. Главный вопрос — что делать с дублирующимися контактами, или контактами с одинаковым названием? Производится основная проверка — существует ли e-mail адрес, если нет, а контакт с таким именем уже создан (что определяется функцией DNExists), то к названию нового контакта добавляется имя компании.

Скрипт переносит только бизнес адреса, но его можно настроить так, чтобы добавлять и домашние. Имейте в виду, что на сегодняшний момент оснастка `Active Directory Users and Computers` не показывает домашние адреса.


'ContactMigationScript.vbs

Dim objRecip
'On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set myOlApp = CreateObject ("Outlook.Application")
Set myNameSpace = myOlApp.Application.GetNamespace("MAPI")
'Get the Public Folder containing the contacts
Set myfolder = myNameSpace.Folders("Public Folders"). _
      Folders("All Public folders").Folders("Public Contacts")
'Open a test file for reporting putposes
Set reportfile = fs.CreateTextFile ("c:\contactreport.txt")
'Look for all contacts in the Public Folder
For I = 1 To myfolder.Items.Count
   If TypeName(myfolder.Items.Item(I)) = "ContactItem" Then
              Set outlookcontact = myfolder.Items(I)
'Fix the FileAs field so it won't contain Linefeeds.
          FixedFileAs = Replace (outlookcontact.FileAs,Chr(13)," - ")
'Get the Public Contacts OU
          Set objContainer = GetObject(LDAP://OU=Public Contacts,DC=company,DC=com)
          TestforContact = False
'Check to see if the e-mail address already exists
          For Each adcontact In objContainer
              If (CStr (outlookcontact.Email1Address)  "") And _
                (CStr(adcontact.mail) = CStr (outlookcontact.Email1Address)) Then _
                 TestforContact = True
'Check to see whether this is a new contact with an existing name, but from a different company
               If  (CStr (adcontact.displayName) = FixedFileAs) And _
                  (CStr (outlookcontact.CompanyName) = CStr (adcontact.company)) Then _
                  TestforContact = True
              Next
'Create a valid directory name for the contact.
         CNName = "CN=" & outlookcontact.FullName
         stAddCompany = ""
         If DNExists (CNNAME) Then
               If outlookcontact.CompanyName = "" Then
                 TestforContact = True
               Else
'If the directory name exists add the company name to it.
             CNName = "CN=" & outlookcontact.FullName & " (" & outlookcontact.CompanyName &  ")"
             If DNExists (CNNAME) Then TestforContact = True
            End If
         End If

          If TestforContact = False then
                     ' Create a Contact

                     Reportfile.WriteLine "Creating: " & FixedFileAs

                        Set objContact = objContainer.Create("contact", CNName)

                      ' Now fill the contact attributes in Active Directory
                        With objContact
                              .Put "displayName", FixedFileAs

                       If outlookcontact.LastName  "" Then _
                             .Put "sn",CStr(outlookcontact.LastName)
                                   If outlookcontact.FirstName  "" Then _
                             .Put "givenName",CStr(outlookcontact.FirstName)
                                   If outlookcontact.CompanyName  "" Then _
                                    .Put "company" , CStr(outlookcontact.CompanyName)
                                   If outlookcontact.Department  "" Then _
                                    .Put "department" , CStr(outlookcontact.department)
                                If outlookcontact.BusinessAddressCity  "" Then _
                                    .Put "l", CStr(outlookcontact.BusinessAddressCity)
                                  If outlookcontact.Title  "" Then _
                                    .Put "title", CStr(outlookcontact.Title)
                                  If outlookcontact.WebPage  "" Then _
                             .Put "wWWHomePage", CStr(outlookcontact.WebPage)
                                  If outlookcontact.Department  "" Then _
                                    .Put "department" , CStr(outlookcontact.Department)
                                  If outlookcontact.BusinessAddressStreet  "" Then _
                              .Put "streetAddress" , CStr(outlookcontact.BusinessAddressStreet)
                                  If outlookcontact.BusinessAddressPostOfficeBox  "" Then _
                              .Put "postOfficeBox" , CStr(outlookcontact.BusinessAddressPostOfficeBox)
                           If outlookcontact.BusinessAddressPostalCode  "" Then _
                              .Put "postalCode" , CStr(outlookcontact.BusinessAddressPostalCode)
                           If outlookcontact.BusinessAddressState  "" Then _
                              .Put "st" , CStr(outlookcontact.BusinessAddressState)
                           If outlookcontact.BusinessAddressCountry  "" Then
                                    .Put "co", CStr(outlookcontact.BusinessAddressCountry)
'Open a file containing table of Country Name, Country designation (two characters) and Country Code
'(Numberical code like the one used for dialing)
                                    Set codes = fs.OpenTextFile("c:\countrycodes.csv")
                                    Do While not codes.AtEndOfStream
                                      countryst = codes.ReadLine
                                      countryar = Split (countryst,",")
                                      If countryar(0)= CStr(outlookcontact.BusinessAddressCountry) Then
                                          .Put "c",  countryar (1)
                                         .Put "countryCode", CInt(countryar(2))
                                      End If
                                    Loop
                               End If
                           If outlookcontact.BusinessTelephoneNumber  "" Then _
                            .Put "telephoneNumber" ,  CStr(outlookcontact.BusinessTelephoneNumber)
                           If outlookcontact.HomeTelephoneNumber  "" Then _
                            .Put "homephone" ,  CStr(outlookcontact.HomeTelephoneNumber)
                           If outlookcontact.PagerNumber  "" Then _
                            .Put "pager" , CStr(outlookcontact.PagerNumber)
                           If outlookcontact.MobileTelephoneNumber  "" then _
                            .Put "Mobile", CStr(outlookcontact.MobileTelephoneNumber)
'Create the mailNickname (alias) attribute from the e-mail and mail-enable the contact.
                           If outlookcontact.Email1Address  "" Then
                                   Set objRecip = objContact
                                   TempAr = Split (outlookcontact.Email1Address,"@")
                                   objRecip.mailNickname = TempAr (0) & "at" & TempAr (1)
                                   FwdAddress = "SMTP:" & outlookcontact.Email1Address
                                   objRecip.MailEnable FwdAddress
                           End If
                           .SetInfo

                  End With

          Else
              Reportfile.WriteLine "Ignoring " & FixedFileAs
          End If
       End If
Next

Reportfile.close

Function DNExists (dn)
'Determines if a directory name exists by querying Active Directory using LDAP
        DNExists = False
        Set rootDSE=GetObject(LDAP://RootDSE)
        DomainContainer = rootDSE.Get("defaultNamingContext")
        Set conn = CreateObject("ADODB.Connection")
        conn.Provider = "ADSDSOObject"
        conn.Open "ADs Provider"
        ldapStr = ";(& (cn=" & Mid (dn,4)  & ") );adspath;subtree"
        Set rs = conn.Execute(LDAPStr)
        If rs.RecordCount = 1 Then DNExists = True
        conn.Close
End Function

Самое важное свойство — это e-mail адрес. В Active Directory контакту сопоставлен один почтовый адрес, также присвоен алиас Exchange, называющийся «mailNickname». Это свойство реально не используется, но должно быть уникальным в AD для создаваемых контактов. В скрипте это достигается заменой «@» в адресе почты на «at», но могут быть и другие способы.

Данный скрипт переносит только первый e-mail. Контакты должны быть отмечены Exchange сервером перед тем, как добавлять какие-то дополнительные адреса. Далее представлен скрипт, подлежащий запуску после того, как отработал Exchange RUS(обычно через 15 минут после запуска скрипта переноса).

Второй скрипт просматривает все контакты в Общей Папке, находя соответствующие контакты, отмеченные Exchange'ом, и добавляет e-mail адрес. Outlook поддерживает три адреса на контакт, но я считаю, что хватит и двух. Если вам нужны три e-mail адреса, просто измените поле «Email2Address» на «Email3Address» и запустите скрипт ещё раз.


Dim objRecip
    Dim mycontact' As ContactItem
    Dim proxies
    'On Error Resume Next
    Set rootDSE=GetObject(LDAP://RootDSE)
    DomainContainer = rootDSE.Get("defaultNamingContext")
'Open a connection to the Public Contacts public folder
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.Application.GetNamespace("MAPI")
    Set myfolder = myNameSpace.Folders("Public Folders"). _
        Folders("All Public folders").Folders("Public Contacts")
'Open a connection to Active Directory
    Set conn = CreateObject("ADODB.Connection")
   conn.Provider = "ADSDSOObject"
   conn.Open "ADs Provider"
'Run through all the contacts in the public folder
    For I = 1 To myfolder.Items.Count
        If TypeName(myfolder.Items.Item(I)) = "ContactItem" Then
            Set mycontact = myfolder.Items(I)
' If a contact has a second e-mail address find the first contact in Active Directory
' by using the first e-mail address
            If (mycontact.Email2Address  "") Then
                LDAPStr = ";(&(objectCategory=contact)(mail=" _
                  & mycontact.Email1Address & "));adspath;subtree"
                 Set rs = conn.Execute(LDAPStr)
                 If rs.RecordCount = 1 Then
                     Set oContact = GetObject(rs.Fields(0).Value)
                     Set objRecip = oContact
'Add the second e-mail address to the contact if it is njot already a property of the contact
                      sAddress = "smtp:" & mycontact.Email2Address
                       bIsFound = False
                       vProxyAddresses = objRecip.ProxyAddresses
                       nProxyAddresses = UBound(vProxyAddresses)
                       nProxyAddress = 0
                       Do While nProxyAddress 

Перенос списков рассылок

Списки рассылок — слабое место в Outlook. Так как Outlook реально не является директорией (как, например, Active Directory), появляются проблемы с отслеживанием местонахождения того или иного контакта, принадлежащего списку. Также, если вы импортируете или экспортируете ссылки на удалённые контакты, могу возникнуть некоторые проблемы.

Перенос списков требует создания Universal группы в AD для каждого списка и просмотра e-mail адресов существующих контактов AD.


        Dim MyDl
        Dim objRecip
        Dim mailar(2)
       ' On Error Resume Next

        Set rootDSE=GetObject(LDAP://RootDSE)
        DomainContainer = rootDSE.Get("defaultNamingContext")
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set userFile = fs.CreateTextFile("c:\DLConvertReport.txt")
        Set myOlApp = CreateObject("Outlook.Application")
        Set myNameSpace = myOlApp.Application.GetNamespace("MAPI")
    'Open a connection to the DLs public folder.
        Set myfolder = myNameSpace.Folders("Public Folders"). _
            Folders("All Public folders").Folders("DLs")

        FindContactinDLs = False
    'Go through all the distribution lists in the folder
        For I = 1 To myfolder.Items.Count
            If TypeName(myfolder.Items.Item(I)) = "DistListItem" Then

                Set MyDl = myfolder.Items(I)
    '  Set the Type of Group as Universal Distribution Group

                 lGroupType = &H8 'ADS_GROUP_TYPE_UNIVERSAL_GROUP
    ' Create the Group

                 Set objContainer = GetObject(LDAP://OU=DLs,DC=company,DC=com)
                 strGroupName = MyDl.DLName
     Set iAdGroup = objContainer.Create("group", "cn=" + strGroupName)
    ' Create a login name for the group that conforms to the NT4 standards
                 strSamAcctName = "DL" & Replace(strGroupName, " ", "")
                 strSamAcctName = Left(strSamAcctName, 12)
    'Add a number at the end of login name of the group if it exists
                n = 2
                 If LoginNameExists (strSamAcctName) Then _
                      strSamAcctName = strSamAcctName & "2"
                 Do While LoginNameExists (strSamAcctName)
                   n = n + 1
                   strSamAcctName = Left (strSamAcctName,12) & CStr (n)
                 Loop
                 iAdGroup.Put "sAMAccountName", strSamAcctName
                 iAdGroup.Put "groupType", lGroupType
                 userFile.WriteLine "Creating   " & strGroupName
    ' Flush to the directory
                 iAdGroup.SetInfo

    'Mail Enable
                 Set iMailGroup = iAdGroup
                 iMailGroup.mail = strSamAcctName & "@company.com"
                 iMailGroup.MailEnable

    ' Write Exchange information to the directory.
                 iAdGroup.SetInfo
    ' Look for members of the distribution list in Active Directory
                 For y = 1 To MyDl.MemberCount
                      Set DLMember =  MyDl.GetMember(y)
                     WScript.Echo DLMember.Name & "  " & DLMember.Address
                      If DLMember.Address  "" Then
                                   contactMail = MyDl.GetMember(y).Address
                                   recipient =
                                   Set conn = CreateObject("ADODB.Connection")
                                   conn.Provider = "ADSDSOObject"
                                   conn.Open "ADs Provider"

                                   ldapStr = ";(&(&(objectCategory=contact)(!extensionAttribute1=ShowInGAL)" & _
    "(&(&(& (| (&(objectCategory=person)(objectClass=contact))" & _
    ")))(objectCategory=contact)(proxyAddresses=smtp:" & _
    CStr(contactMail) & "))));adspath;subtree"

                                    Set rs = conn.Execute(ldapStr)
     'If contact is found add it to the corresponding Universal Group

                                    If Not rs.EOF Then
                                        Set oContact = GetObject(rs.Fields(0).Value)
                                        path = oContact.ADsPath
                                        If Not (iAdGroup.IsMember(path)) Then
                                            userFile.WriteLine "  Adding Contact   " & path
                                            iAdGroup.Add path
                                            iAdGroup.SetInfo
                                        End If
                                    End If
                                Else
    'If member is a Distribution list itself, look for it in Active Directory
    'and add it to the Universal Group
                                   DLName = MyDl.GetMember(y).Name
                                   Set conn = CreateObject("ADODB.Connection")
                                    conn.Provider = "ADSDSOObject"
                                   conn.Open "ADs Provider"

                                 ldapStr = ";(&(&(&(& (mailnickname=*) (| (objectCategory=group)
)))(objectCategory=group)(displayName=" & DLName & ")));adspath;subtree"

                                    Set rs = conn.Execute(ldapStr)

                                    If Not rs.EOF Then
                                       Set oUDG = GetObject(rs.Fields(0).Value)
                                        path = oUDG.ADsPath
                                        userFile.WriteLine "  Adding DL   " & path
                                         If Not (iAdGroup.IsMember(path)) Then
                                             iAdGroup.Add path
                                             iAdGroup.SetInfo
                                         End If
                                    End If
                                End If
                Next
            End If
        Next

        Function LoginNameExists (login)
          'Check to see if login name already exists in Active Directory
           LoginNameExists = False
           Set rootDSE=GetObject(LDAP://RootDSE)
           DomainContainer = rootDSE.Get("defaultNamingContext")
           Set conn = CreateObject("ADODB.Connection")
           conn.Provider = "ADSDSOObject"
           conn.Open "ADs Provider"
           WScript.Echo login
           ldapStr = ";(& (sAMAccountName=" & login & ") );adspath;subtree"
           Set rs = conn.Execute(LDAPStr)
           If rs.RecordCount = 1 Then LoginNameExists = True
           conn.Close
    End Function

Заключение

Эти скрипты кому-то могут показаться сложными, но их настройка под конкретный домен очень проста. С другой стороны, они являются хорошим стимулом для освоения написания сценариев для AD. Огромный плюс скриптов по сравнению с различными мастерами в том, что вы добиваетесь абсолютной гибкости процесса. Существует возможность написания практически любого правила, как то: не пропустить ненужный контакт при переносе, определить политику создания имён и т.п. Вы можете создавать любые контакты в любых папках, в соответствие какому-то выбранному критерию. Предел только один — ваша фантазия.





Рейтинг:  
4.1 (голосов 15)  
 1   2   3   4   5    

Автор: Амит Зинман (Amit Zinman)
В настоящее время работает в качестве Менеджера Проекта и Системного Консультанта, руководя и консультируя в области миграций и разработок, основанных на Exchange и NT/Windows 2000, для больших компаний, таких как Checkpoint, Comverse, Smarteam, Nice, Aladdin и ведущих Банков Израиля. Также он участвует в написании скриптов и пользовательских решений для клиентов, основанных на ADSI, CDO и Visual Basic, и преподавании Windows 2000 и Exchange 2000 в MSCE колледжах и на лекциях в Microsoft User Groups.
Эта статья переведена и опубликована с разрешения http://www.msexchange.org

Эта статья переведена силами и средствами компании Red Line Software. Размещение данного переведенного материала на других сайтах без разрешения компании Red Line Software запрещается.





Печать пластиковых карт - это часть процесса изготовления и производства пластиковых карт