1 (изменено: Kail, 2016-07-20 13:21:14)

Тема: VBS: Добавление/удаление адресной книги ldap в outlook 2013

Скрипт должен добавлять адресную книгу с заданным фильтром поиска, удалив все имеющиеся на данный момент. На данном этапе: книга добавляется, удаления не происходит; при первом запуске outlook выводит окно настройки каталогов LDAP (где прописано имя сервера и есть пустые поля под имя\пароль), в котором нужно просто нажать ОК. Событие однократное, но тем не менее нежелательное.

On Error Resume Next 
const HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set oReg=GetObject( "winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
RegistryFolder = "Software\Microsoft\Office\15.0\Outlook\Profiles\Outlook\"
 
LDAPdisplayname = "Название книги"
LDAPserver = "Ваши данные"
LDAPport = "389"
LDAPsearchbase = "ou=Ваши данные,dc=Ваши данные,dc=Ваши данные"
 
 
'Add Ldap Type Key
sKeyPath = RegistryFolder & "e8cb48869c395445ade13e3c1c80d154\"
oReg.CreateKey HKEY_CURRENT_USER, sKeyPath 
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "00033009", Array(0,0,0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "00033e03", Array(&H23,0,0,0)
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3001", "Microsoft LDAP Directory"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3006", "Microsoft LDAP Directory"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e300a", "EMABLT.DLL"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d09", "EMABLT"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d13", "{6485D268-C2AC-11D1-AD3E-10A0C911C9C0}"
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "01023d0c", Array(&H5c,&Hb9,&H3b,&H24,&Hff,&H71,&H07,&H41,&Hb7,&Hd8,&H3b,&H9c,&Hb6,&H31,&H79,&H92)
 
'Add Ldap connection settings key
sKeyPath = RegistryFolder & "5cb93b24ff710741b7d83b9cb6317992\"
oReg.CreateKey HKEY_CURRENT_USER, sKeyPath
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "00036623", Array(0,0,0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "00033009", Array(&H20,0,0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "000b6613", Array(0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "000b6615", Array(&H01,&H00)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "000b6622", Array(&H01,&H00)
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3001", LDAPdisplayname
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d09", "EMABLT"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d0a", "BJABLR.DLL"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d0b", "ServiceEntry"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d13", "{6485D268-C2AC-11D1-AD3E-10A0C911C9C0}"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6600", LDAPserver
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6601", LDAPport
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6602", ""
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6603", LDAPsearchbase
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6604", "(&(mail=*)(|(mail=%s*)(|(cn=%s*)(|(sn=%s*)(givenName=%s*)))))"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6605", "SMTP"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6606", "mail"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6607", "60"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6608", "100"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6609", "120"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660a", "15"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660b", ""
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660c", "OFF"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660d", "OFF"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660e", "NONE"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660f", "OFF"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6610", "postalAddress"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6611", "cn"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6612", "1"
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "001e67f1", Array(&H0a)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "01023615", Array(&H50,&Ha7,&H0a,&H61,&H55,&Hde,&Hd3,&H11,&H9d,&H60,&H00,&Hc0,&H4f,&H4c,&H8e,&Hfa)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "01023d01", Array(&He8,&Hcb,&H48,&H86,&H9c,&H39,&H54,&H45,&Had,&He1,&H3e,&H3c,&H1c,&H80,&Hd1,&H54)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "01026631", Array(&H98,&H17,&H82,&H92,&H5b,&H43,&H03,&H4b,&H99,&H5d,&H5c,&Hc6,&H74,&H88,&H7b,&H34)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "101e3d0f", Array(&H02,&H00,&H00,&H00,&H0c,&H00,&H00,&H00,&H17,&H00,&H00,&H00,&H45,&H4d,&H41,&H42,&H4c,&H54,&H2e,&H44,&H4c,&H4c,&H00,&H42,&H4a,&H41,&H42,&H4c,&H52,&H2e,&H44,&Hc,&H4c,&H00)
 
'Append to Backup Key for ldap types
sKeyPath = RegistryFolder & "9207f3e0a3b11019908b08002b2a56c2\"
oReg.getBinaryValue HKEY_CURRENT_USER,sKeyPath, "01023d01",Backup
Dim oldLength
oldLength = UBound (Backup)
ReDim Preserve Backup(oldLength+16)
Backup(oldLength+1) = &He8
Backup(oldLength+2) = &Hcb
Backup(oldLength+3) = &H48
Backup(oldLength+4) = &H86
Backup(oldLength+5) = &H9c
Backup(oldLength+6) = &H39
Backup(oldLength+7) = &H54
Backup(oldLength+8) = &H45
Backup(oldLength+9) = &Had
Backup(oldLength+10) = &He1
Backup(oldLength+11) = &H3e
Backup(oldLength+12) = &H3c
Backup(oldLength+13) = &H1c
Backup(oldLength+14) = &H80
Backup(oldLength+15) = &Hd1
Backup(oldLength+16) = &H54
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "01023d01", Backup
 
 
'Append to Backup Key for ldap connection settings
sKeyPath = RegistryFolder & "9207f3e0a3b11019908b08002b2a56c2\"
oReg.getBinaryValue HKEY_CURRENT_USER,sKeyPath, "01023d0e",Backup
oldLength = UBound (Backup)
ReDim Preserve Backup(oldLength+16)
Backup(oldLength+1) = &H5c
Backup(oldLength+2) = &Hb9
Backup(oldLength+3) = &H3b
Backup(oldLength+4) = &H24
Backup(oldLength+5) = &Hff
Backup(oldLength+6) = &H71
Backup(oldLength+7) = &H07
Backup(oldLength+8) = &H41
Backup(oldLength+9) = &Hb7
Backup(oldLength+10) = &Hd8
Backup(oldLength+11) = &H3b
Backup(oldLength+12) = &H9c
Backup(oldLength+13) = &Hb6
Backup(oldLength+14) = &H31
Backup(oldLength+15) = &H79
Backup(oldLength+16) = &H92
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath,  "01023d0e", Backup


 
'Delete Active Books List Key
sKeyPath = RegistryFolder & "9375CFF0413111d3B88A00104B2A6676\{ED475419-B0D6-11D2-8C3B-00104B2A6676}"
oReg.DeleteKey HKEY_CURRENT_USER, sKeyPath

2

Re: VBS: Добавление/удаление адресной книги ldap в outlook 2013

Методом научного тыка выяснил, что для очистки списка всех адресных книг дополнительно нужно удалить еще два ключа в разделе HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Outlook\Profiles\Outlook\9207f3e0a3b11019908b08002b2a56c2. Сами ключи: 01023d01  и  01023d0e.
Проблема в том, что после их удаления скрипт не добавляет новую книгу вообще, даже после повторного запуска. Возможно, требуется сначала провести процедуру удаления этих ключей, чтобы обнулить список активных адресных книг, потом создать их заново, и только потом гнать данный скрипт. Я не силен в VBs и не могу это правильно оформить, чтобы проверить. Буду рад любой помощи

3

Re: VBS: Добавление/удаление адресной книги ldap в outlook 2013

Kail
А примеры с Outlook.Application не дали результатов?
Вместо удаления ключей не проще удалять их значения?:

sKeyPath = RegistryFolder & "9207f3e0a3b11019908b08002b2a56c2\"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "01023d01", ""
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "01023d0e", ""

'Add Ldap Type Key

P.S.: Про точки не забывайте.

4 (изменено: Kail, 2016-07-21 11:22:14)

Re: VBS: Добавление/удаление адресной книги ldap в outlook 2013

Flasher
Если удалить значения этих ключей, то они принимают тип REG_SZ вместо REG_BINARY. С вашими командами адресные книги удаляются, скрипт так же ругается на несоответствие типа "UBound" 69 строка 1 символ:

oldLength = UBound (Backup)

.

Насколько я понимаю, происходит попытка резервного копирования значений, которых там уже нет.

P.S. Да, это я додумался убрать "On Error Resume Next " и посмотреть что происходит)).

5

Re: VBS: Добавление/удаление адресной книги ldap в outlook 2013

Flasher
Информация от автора скрипта.

James McWhinney пишет:

Backup Key
HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9207f3e0a3b11019908b08002b2a56c2
This Key Holds Information that is used to regenerate other registry keys in the event that they are deleted.
01023d01 holds references to the address book type keys.
01023d0e holds references to the address book information keys.

Active Address Books List Key
HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676
This Key is the active listing of address books, personal folders, etc currently in use by outlook.
If you add new Address book type keys and information keys into the Outlook key, they will not be active until they are listed in the active address books key.
You can not manually add an address book into the active address books list key, outlook will detect a problem with the active list, and reload them from the backup list.

Active Address Books List Index Key
HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676

{ED475419-B0D6-11D2-8C3B-00104B2A6676}
This key is the index for the Active Address Book list

How to load a new address book into the active list
1. Load the address book type key and the address book information key into the outlook key.
2. Add the address book type key name into the Backup key 01023d01.
3. Add the address book information key name into the Backup key 01023d0e.
4. Delete the Active Address Books List Index Key.
5. Run Outlook and the Active Address books List Key will be automatically regenerated.

6

Re: VBS: Добавление/удаление адресной книги ldap в outlook 2013

Kail пишет:

то они принимают тип REG_SZ вместо REG_BINARY.

Ясно. Array(0, 0) вместо "" указать попробуйте.

7

Re: VBS: Добавление/удаление адресной книги ldap в outlook 2013

Flasher
В этом случае ошибка "Несоответствие типа", в первом символе строки:

oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "01023d01", Array(0,0)