'---------------------------------------------------------
'  Перед запуском скрипта необходимо заменить переменные:
'  DomainName - имя домена;
'  BS - путь к файлу Business Studio;
'  Server - имя сервера;
'  DB - имя базы;
'  Dir - каталог экспорта-импорта.
'---------------------------------------------------------


'---- настройки ------
DomainName="DC=MyDomain,DC=Local"   'имя домена
ObjFilter="user"                    'фильтр по типам объектов

''' доп. фильтр по именам объектов (регулярные выражения):
'NameFilter=".+"	      		    'любое, кроме пустого
'NameFilter="^[^a-z0-9]+$"        	'не содержащее английскийх букв и цифр
'NameFilter="^\W+ \W+ \W+$"     	'строго 3 слова, разделенные пробелом, не содержащие английских букв, цифр и знака подчеркивания
NameFilter="^\W+ \W+( \W+|)$"     	'то же, но 2 или 3 слова
'по регулярным выражениям см. http://msdn2.microsoft.com/en-us/library/ms974570.aspx

BS="C:\Program Files\STU-Soft\Business Studio 2.0\Business Studio.exe" 'путь к файлу Business Studio
Server="MyServer"    'имя сервера
DB="MyBase"          'имя базы
Dir="C:\AD"          'каталог экспорта-импорта   
'---------------------

File = "Users.xls"    'файл экспорта-импорта

fn = Dir + "\" + File

set Excel = CreateObject("Excel.Application") 
Excel.Visible = true 'видимость Excel
set xlWorkBook = Excel.Workbooks.Add  'новая книга
if xlWorkBook.Sheets.Count < 1 then xlWorkBook.Sheets.Add() 
set xlSheet = Excel.ActiveWorkbook.Worksheets(1) 
xlSheet.Name = "AD Users"
xlSheet.Cells(1, 1).Value = "Фамилия" 
xlSheet.Cells(1, 2).Value = "Имя" 
xlSheet.Cells(1, 3).Value = "Отчество" 
xlSheet.Cells(1, 4).Value = "E-mail" 
xlSheet.Cells(1, 5).Value = "Тип контакта" 
xlSheet.Range("A1:Z1").Font.Bold = True 
Excel.Columns(1).ColumnWidth = 30
Excel.Columns(2).ColumnWidth = 30
Excel.Columns(3).ColumnWidth = 30
Excel.Columns(4).ColumnWidth = 30
Excel.Columns(5).ColumnWidth = 30

xlLine=2

ExportUnit("CN=USERS,"&DomainName)	'экспорт из стандартного контейнера
'ExportUnit("OU=MyUsers,"&DomainName)	'экспорт из дополнительного контейнера

set fso = CreateObject("Scripting.FileSystemObject")
on error resume next
fso.CreateFolder(Dir)
fso.DeleteFile(fn)
on error goto 0

Excel.ActiveWorkbook.SaveAs(Dir + "\" + File)	'сохранить файл
Excel.ActiveWorkbook.Close			'закрыть книгу
Excel.Application.Quit				'выйти из Excel

'--- автоимпорт в базу ---
set WshShell = CreateObject("WScript.Shell")
WshShell.Exec(""""+BS+""" /server="+Server+" /db="+DB+" /runcmd=""БизнесМодель.КлиентскиеМетоды.Автоимпортер "+Dir+",Импорт физлиц из Active Directory,5000""")


'====== конец ===========

sub ExportUnit(UnitName)  'check 

set oTargetOU = GetObject("LDAP://"&UnitName)

oTargetOU.Filter = Array(ObjFilter)

set regEx = new RegExp 
regEx.Pattern = NameFilter  
regEx.IgnoreCase = True  
regEx.Global = false     


for each usr in oTargetOU
  uDisplayName = usr.DisplayName
  uAccountName = usr.SamAccountName
  uDisabled = (usr.UserAccountControl and 2)<>0
  uEmail = usr.Mail

  set Matches = regEx.Execute(uDisplayName)   ' фильтр по имени

  if ((Matches.Count > 0) and (not uDisabled)) then

    'set match = Matches(0)
    'for i = 0 to match.SubMatches.Count - 1
      'xlSheet.Cells(xlLine, i + 1).Value = match.SubMatches(i)
    'next
    a = Split(uDisplayName, " ")
    l = UBound(a)
    if (l >= 0) then xlSheet.Cells(xlLine, 1).Value = a(0)
    if (l >= 1) then xlSheet.Cells(xlLine, 2).Value = a(1)
    if (l >= 2) then xlSheet.Cells(xlLine, 3).Value = a(2)
    xlSheet.Cells(xlLine, 4).Value = uEmail
    xlSheet.Cells(xlLine, 5).Value = "Электронная почта"
    xlLine = xlLine + 1

  end if
next

end sub