Click here to Skip to main content
14,981,768 members
Articles / Programming Languages / VBScript
Article
Posted 8 May 2006

Stats

109.8K views
17 bookmarked

Adding an LDAP address book to MS Outlook

Rate me:
Please Sign up or sign in to vote.
4.00/5 (4 votes)
8 May 20061 min read
How to add an LDAP address book into MS Outlook, using VBScript.

Introduction

This code adds an LDAP address book into Outlook by modifying registry keys. In its current form, it can only be used to add one address book. If it is run a second time, it will overwrite the address book that was created the first time it was run.

Background

Backup Key

HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\
  Windows Messaging Subsystem\Profiles\Outlook\
  9207f3e0a3b11019908b08002b2a56c2

This key holds the information that is used to regenerate other registry keys in the event that they are deleted.

  • 01023d01 holds the references to the address book type keys.
  • 01023d0e holds the 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

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

The code

VBScript
'-=-=-=-=-=-=-=-=-=-=-=-=-=-
'Written By James McWhinney
'Vancouver BC, Canada
'www.importfanatik.com
'April 26th, 2006
'-=-=-=-=-=-=-=-=-=-=-=-=-=-

const HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set oReg=GetObject( "winmgmts:{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\default:StdRegProv")
RegistryFolder = "Software\Microsoft\Windows NT\" & _ 
  "CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\"

LDAPdisplayname = "test"
LDAPserver = "ldap.test.ca"
LDAPport = "389"
LDAPsearchbase = "o=test.ca"


'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, "00033009", Array(&H20,0,0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6613", Array(0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6615", Array(0,0)
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 & "9375CFF0413111d3B88A001" & _ 
           "04B2A6676\{ED475419-B0D6-11D2-8C3B-00104B2A6676}"
oReg.DeleteKey HKEY_CURRENT_USER, sKeyPath

Points of Interest

I wrote this script to avoid calling 200+ users to walk them through adding an LDAP address book into MS Outlook.

After hours of searching the web for a way to do this (group policy etc.), I found nothing. As far as I can tell, this section of the Outlook registry was undocumented until now.

It took me over 10 hours to figure out, and another 8 to make the VBScript code work.

License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here

Share

About the Author

No Biography provided

Comments and Discussions

 
Questionadd second ldap address book Pin
Member 137660016-Apr-18 3:05
MemberMember 137660016-Apr-18 3:05 
SuggestionNew solution - MAPI based utility Pin
Mitja Tomažič11-Jul-17 2:24
MemberMitja Tomažič11-Jul-17 2:24 
NewsProblem in section 'Get Contacts Registry Key' Pin
nacken20085-Jul-17 4:27
Membernacken20085-Jul-17 4:27 
Newsmy current Code Pin
nacken200815-Jun-17 4:52
Membernacken200815-Jun-17 4:52 
Hi,

i spent another 5 days in development. I solved problems with:
- password encryption and portability of the script to other computers and users
- adress book search order (if you need another order change it in outlook and see what happens to the 11023d05 key, build this syntax with the script)
- script ran multiple times and added the ldap adress book key multiple time

Environment is exchange server 2016 (with global adress list and user's individual contacts) and office 2016.

Here is the new code:
' BASED ON: https://www.codeproject.com/Articles/14053/Adding-an-LDAP-address-book-to-MS-Outlook
' MODIFIED BY nacken2008

' IGNORE ANY ERRORS:
'On Error Resume Next

const HKEY_CURRENT_USER = &H80000001

Set objShell = WScript.CreateObject("Wscript.Shell")
Set objRegistry = GetObject( "winmgmts:{impersonationLevel=impersonate}!\\" & CreateObject("WScript.Network").ComputerName & "\root\default:StdRegProv")

strRegistryFolder = "Software\Microsoft\Office\16.0\Outlook\Profiles\Outlook"
strMailAccountsSubKey = "9375CFF0413111d3B88A00104B2A6676"
strSearchString = "Service UID"
strLDAPDisplayNameID = "001e3001"
strLDAPServerNameID = "001e6600"
strLDAPDisplayName = "LDAP Address Book"
strLDAPServerName = "ldap.domainname.com"
strLDAPPort = "636"
strLDAPSearchBase = ""
strLDAPUserLogin = "ldap@domainname.com"
strLDAPUserPassword = "MyC00Le$Tp@$$vv0Rd"

If objRegistry.EnumKey(HKEY_CURRENT_USER, strRegistryFolder, arrSubKeys) <> 0 Then
		'msgbox("Outlook Profile does not exist")
		WScript.Quit
End If
If objRegistry.EnumKey(HKEY_CURRENT_USER, strRegistryFolder & "\" & "e8cb48869c395445ade13e3c1c80d154", arrSubKeys) = 0 Then
		'msgbox("Key e8cb48869c395445ade13e3c1c80d154 already exists")
		WScript.Quit
End If

strCMD = "powershell.exe -noninteractive -command " & Chr(34) & "$Password = '" & strLDAPUserPassword & "' | ConvertTo-SecureString -AsPlainText -Force | ConvertFrom-SecureString; Write-Host $Password" & Chr(34)
Set objScriptExec = objShell.Exec(strCMD)
objScriptExec.StdIn.Close()
strLDAPUserPassword = objScriptExec.StdOut.ReadAll
If (objScriptExec.status = 1) Then
	DELIMITER = "||"
	i = 0
	do while len(strLDAPUserPassword) <> 0
		current = left(strLDAPUserPassword, 2)
		strLDAPUserPassword = right(strLDAPUserPassword, len(strLDAPUserPassword) - len(current))
		output = output & "&H" & current & DELIMITER
		If ((3 < i) And (i <= 19)) Then
			strS001e67f1_1 = strS001e67f1_1 & "&H" & current & DELIMITER
		End If
		If ((23 < i) And (i <= 39)) Then
			strS001e67f1_2 = strS001e67f1_2 & "&H" & current & DELIMITER
		End If
		i = i + 1
	loop
	output = left(output, len(output) - len(DELIMITER) - 5)
	objLDAPUserPassword = split(output, DELIMITER)
	strS001e67f1 = "&H01||&H00||&H00||&H00||" & strS001e67f1_1 & "&H01||&H00||&H00||&H00||" & strS001e67f1_2 & "&H00||&H00||&H00||&H00||&H14||&H00||&H00||&H00||&H53||&H00||&H30||&H00||&H30||&H00||&H31||&H00||&H65||&H00||&H36||&H00||&H37||&H00||&H66||&H00||&H31||&H00||&H00||&H00||&H03||&H66||&H00||&H00||&Hc0||&H00||&H00||&H00||&H10||&H00||&H00||&H00||&H53||&H31||&Hf3||&H19||&H7e||&Hbb||&H8a||&Hb6||&H59||&Hcd||&H26||&Hf6||&H3d||&H75||&Hc8||&Hc2||&H00||&H00||&H00||&H00||&H04||&H80||&H00||&H00||&Ha0||&H00||&H00||&H00||&H10||&H00||&H00||&H00||&H60||&H21||&H78||&H2d||&Hb2||&H24||&He4||&H4c||&H77||&Hb4||&H1b||&H98||&Hbc||&Hec||&H40||&H3e||&H08||&H00||&H00||&H00||&Hba||&H6f||&Hed||&Ha4||&H68||&Hcd||&H84||&Hd5||&H14||&H00||&H00||&H00||&H49||&H88||&H84||&H2d||&Hc8||&H50||&H35||&Hcb||&Hfa||&H43||&He7||&H15||&Hdd||&Hbb||&H9c||&H39||&Hc1||&Hf9||&H09||&H94"	
	objS001e67f1 = split(strS001e67f1, DELIMITER)
	strFlagCreateAccount = "yes"
Else
	strFlagCreateAccount = "no"
End if

objRegistry.EnumKey HKEY_CURRENT_USER, strRegistryFolder & "\" & strMailAccountsSubKey, arrProfiles
For Each strSubfolder In arrProfiles
	'msgbox (strSubfolder)
	objRegistry.GetBinaryValue HKEY_CURRENT_USER, strRegistryFolder & "\" & strMailAccountsSubKey & "\" & strSubfolder, strSearchString, strRetVal
	strSubfolderName = ""
	For i = lBound(strRetVal) to uBound(strRetVal)
		strRetVal_temp = Dec2Hex(strRetVal(i))
		If (Len (strRetVal_temp) < 2) Then
			strSubfolderName = strSubfolderName & "0" & strRetVal_temp
		Else 
			strSubfolderName = strSubfolderName & strRetVal_temp
		End if
	Next
	If (strSubfolderName <> "") Then
		'msgbox (strRegistryFolder & "\" & LCase (strSubfolderName))
		objRegistry.GetStringValue HKEY_CURRENT_USER, strRegistryFolder & "\" & LCase (strSubfolderName), strLDAPDisplayNameID, strLDAPDisplayNameValue
		If (strLDAPDisplayNameValue <> "") Then
			If (strLDAPDisplayNameValue = strLDAPDisplayName) Then
				strFlagCreateAccount = "no"
			End if
		End if
		objRegistry.GetStringValue HKEY_CURRENT_USER, strRegistryFolder & "\" & LCase (strSubfolderName), strLDAPServerNameID, strLDAPServerNameValue
		If (strLDAPServerNameValue <> "") Then
			If (strLDAPServerNameValue = strLDAPServerName) Then
				strFlagCreateAccount = "no"
			End if
		End if
	End if
Next

If (strFlagCreateAccount = "yes") Then
	CreateAccount objRegistry, HKEY_CURRENT_USER, strRegistryFolder, strLDAPDisplayName, strLDAPServerName, strLDAPPort, strLDAPSearchBase, strLDAPUserLogin, objLDAPUserPassword, objS001e67f1
End If

Function Dec2Hex (ByVal numAny)
	Dim Sign
	Const maxNum = 9007199254740991
	Const HexChars = "0123456789ABCDEF"
	Sign = Sgn(numAny)
	numAny = Fix(Abs(CDbl(numAny)))
	If numAny > CDbl(maxNum) Then
		Wscript.Echo "Dec2Hex Error: " & numAny & " must be greater/less than +/- 9,007,199,254,740,991"
		Dec2Hex = Empty
	Exit Function
	End If 'numAny > maxNum
	If numAny = 0 Then
		Dec2Hex = "0"
		Exit Function
	End If
	While numAny > 0
		Dec2Hex = Mid(HexChars, 1 + (numAny - 16 * Fix(numAny / 16)), 1) & Dec2Hex
		numAny = Fix(numAny/16)
	WEnd
	If Sign = -1 Then Dec2Hex = "-" & Dec2Hex
End Function 'Dec2Hex

Function CreateAccount (objRegistry, HKEY_CURRENT_USER, strRegistryFolder, strLDAPDisplayName, strLDAPServerName, strLDAPPort, strLDAPSearchBase, strLDAPUserLogin, objLDAPUserPassword, objS001e67f1)
'Add Ldap Type Key
	sKeyPath = strRegistryFolder & "\" & "e8cb48869c395445ade13e3c1c80d154\"
	objRegistry.CreateKey HKEY_CURRENT_USER, sKeyPath
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f300a", Array(&H45,&H00,&H4d,&H00,&H41,&H00,&H42,&H00,&H4c,&H00,&H54,&H00,&H2e,&H00,&H44,&H00,&H4c,&H00,&H4c,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d13", Array(&H7b,&H00,&H36,&H00,&H34,&H00,&H38,&H00,&H35,&H00,&H44,&H00,&H32,&H00,&H36,&H00,&H38,&H00,&H2d,&H00,&H43,&H00,&H32,&H00,&H41,&H00,&H43,&H00,&H2d,&H00,&H31,&H00,&H31,&H00,&H44,&H00,&H31,&H00,&H2d,&H00,&H41,&H00,&H44,&H00,&H33,&H00,&H45,&H00,&H2d,&H00,&H31,&H00,&H30,&H00,&H41,&H00,&H30,&H00,&H43,&H00,&H39,&H00,&H31,&H00,&H31,&H00,&H43,&H00,&H39,&H00,&H43,&H00,&H30,&H00,&H7d,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3006", Array(&H4d,&H00,&H69,&H00,&H63,&H00,&H72,&H00,&H6f,&H00,&H73,&H00,&H6f,&H00,&H66,&H00,&H74,&H00,&H20,&H00,&H4c,&H00,&H44,&H00,&H41,&H00,&H50,&H00,&H2d,&H00,&H56,&H00,&H65,&H00,&H72,&H00,&H7a,&H00,&H65,&H00,&H69,&H00,&H63,&H00,&H68,&H00,&H6e,&H00,&H69,&H00,&H73,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00033e03", Array(&H23,0,0,0)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d0c", Array(&H5c,&Hb9,&H3b,&H24,&Hff,&H71,&H07,&H41,&Hb7,&Hd8,&H3b,&H9c,&Hb6,&H31,&H79,&H92)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d09", Array(&H45,&H00,&H4d,&H00,&H41,&H00,&H42,&H00,&H4c,&H00,&H54,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3001", Array(&H4d,&H00,&H69,&H00,&H63,&H00,&H72,&H00,&H6f,&H00,&H73,&H00,&H6f,&H00,&H66,&H00,&H74,&H00,&H20,&H00,&H4c,&H00,&H44,&H00,&H41,&H00,&H50,&H00,&H2d,&H00,&H56,&H00,&H65,&H00,&H72,&H00,&H7a,&H00,&H65,&H00,&H69,&H00,&H63,&H00,&H68,&H00,&H6e,&H00,&H69,&H00,&H73,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00033009", Array(0,0,0,0)
'Add Ldap connection settings key
	sKeyPath = strRegistryFolder & "\" & "5cb93b24ff710741b7d83b9cb6317992\"
	objRegistry.CreateKey HKEY_CURRENT_USER, sKeyPath
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d13", Array(&H7b,&H00,&H36,&H00,&H34,&H00,&H38,&H00,&H35,&H00,&H44,&H00,&H32,&H00,&H36,&H00,&H38,&H00,&H2d,&H00,&H43,&H00,&H32,&H00,&H41,&H00,&H43,&H00,&H2d,&H00,&H31,&H00,&H31,&H00,&H44,&H00,&H31,&H00,&H2d,&H00,&H41,&H00,&H44,&H00,&H33,&H00,&H45,&H00,&H2d,&H00,&H31,&H00,&H30,&H00,&H41,&H00,&H30,&H00,&H43,&H00,&H39,&H00,&H31,&H00,&H31,&H00,&H43,&H00,&H39,&H00,&H43,&H00,&H30,&H00,&H7d,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d0a", Array(&H45,&H00,&H4d,&H00,&H41,&H00,&H42,&H00,&H4c,&H00,&H54,&H00,&H2e,&H00,&H44,&H00,&H4c,&H00,&H4c,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "101e3d0f", Array(&H01,&H00,&H00,&H00,&H08,&H00,&H00,&H00,&H45,&H4d,&H41,&H42,&H4c,&H54,&H2e,&H44,&H4c,&H4c,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d0b", Array(&H53,&H00,&H65,&H00,&H72,&H00,&H76,&H00,&H69,&H00,&H63,&H00,&H65,&H00,&H45,&H00,&H6e,&H00,&H74,&H00,&H72,&H00,&H79,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00033009", Array(&H20,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f6604", Array(&H28,&H00,&H26,&H00,&H28,&H00,&H6d,&H00,&H61,&H00,&H69,&H00,&H6c,&H00,&H3d,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H7c,&H00,&H28,&H00,&H6d,&H00,&H61,&H00,&H69,&H00,&H6c,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H7c,&H00,&H28,&H00,&H63,&H00,&H6e,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H7c,&H00,&H28,&H00,&H73,&H00,&H6e,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H67,&H00,&H69,&H00,&H76,&H00,&H65,&H00,&H6e,&H00,&H4e,&H00,&H61,&H00,&H6d,&H00,&H65,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H29,&H00,&H29,&H00,&H29,&H00,&H29,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d09", Array(&H45,&H00,&H4d,&H00,&H41,&H00,&H42,&H00,&H4c,&H00,&H54,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", Array(&He8,&Hcb,&H48,&H86,&H9c,&H39,&H54,&H45,&Had,&He1,&H3e,&H3c,&H1c,&H80,&Hd1,&H54)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023615", Array(&H50,&Ha7,&H0a,&H61,&H55,&Hde,&Hd3,&H11,&H9d,&H60,&H00,&Hc0,&H4f,&H4c,&H8e,&Hfa)
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6600", strLDAPServerName
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6601", strLDAPPort
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6602", strLDAPUserLogin
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "S001e67f1", objS001e67f1
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6622", Array(&H00,&H00)
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6603", strLDAPSearchBase
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6605", "SMTP"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6606", "mail"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6607", "60"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6608", "100"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6609", "120"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660a", "15"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660b", ""
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660c", "OFF"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660d", "OFF"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660e", "NONE"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660f", "OFF"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6610", "postalAddress"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6611", "cn"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6612", "1"
	objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3001", strLDAPDisplayName
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6613", Array(&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6615", Array(&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026617", objLDAPUserPassword
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00036623", Array(&H00,&H00,&H00,&H00)
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026631", Array(&H5b,&Hfe,&H3f,&He9,&H65,&H55,&H19,&H48,&H9c,&H52,&H2d,&H68,&Hfc,&Hb9,&H89,&Hbf)
	'objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d09", "EMABLT"
	'objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d0a", "BJABLR.DLL"
	'objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d0b", "ServiceEntry"
	'objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d13", "{6485D268-C2AC-11D1-AD3E-10A0C911C9C0}"
	'objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6604", "(&(mail=*)(|(mail=%s*)" & "(|(cn=%s*)(|(sn=%s*)(givenName=%s*)))))"'objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001e67f1", Array(&H0a)
'Append to Backup Key for ldap types
	sKeyPath = strRegistryFolder & "\" & "9207f3e0a3b11019908b08002b2a56c2\"
	objRegistry.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
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", Backup
	
'Get Contacts Registry Key
	For num = LBound(Backup) To LBound(Backup) + 15
		strRetVal_temp = Dec2Hex(Backup(num))
		If (Len (strRetVal_temp) < 2) Then
			contactskey = contactskey & "0" & strRetVal_temp
		Else 
			contactskey = contactskey & strRetVal_temp
		End if
	Next

'array for ABSearchOrder
	Dim ABSearchOrder(203)
	ABSearchOrder(0) = &H03
	ABSearchOrder(1) = &H00
	ABSearchOrder(2) = &H00
	ABSearchOrder(3) = &H00
	ABSearchOrder(4) = &H1e
	ABSearchOrder(5) = &H00
	ABSearchOrder(6) = &H00
	ABSearchOrder(7) = &H00
	ABSearchOrder(8) = &H1c
	ABSearchOrder(9) = &H00
	ABSearchOrder(10) = &H00
	ABSearchOrder(11) = &H00
	ABSearchOrder(12) = &H5a
	ABSearchOrder(13) = &H00
	ABSearchOrder(14) = &H00
	ABSearchOrder(15) = &H00
	ABSearchOrder(16) = &H3c
	ABSearchOrder(17) = &H00
	ABSearchOrder(18) = &H00
	ABSearchOrder(19) = &H00
	ABSearchOrder(20) = &H33
	ABSearchOrder(21) = &H00
	ABSearchOrder(22) = &H00
	ABSearchOrder(23) = &H00
	ABSearchOrder(24) = &H98
	ABSearchOrder(25) = &H00
	ABSearchOrder(26) = &H00
	ABSearchOrder(27) = &H00
	ABSearchOrder(28) = &H00
	ABSearchOrder(29) = &H00
	ABSearchOrder(30) = &H00
	ABSearchOrder(31) = &H00
'GAL ID 1, length 16
	For n = 32 To 47
		ABSearchOrder(n) = Backup(n - 16)
	Next
'GAL ID 1 end
	ABSearchOrder(48) = &H01
	ABSearchOrder(49) = &H00
	ABSearchOrder(50) = &H00
	ABSearchOrder(51) = &H00
	ABSearchOrder(52) = &H00
	ABSearchOrder(53) = &H01
	ABSearchOrder(54) = &H00
	ABSearchOrder(55) = &H00
	ABSearchOrder(56) = &H2f
	ABSearchOrder(57) = &H00
	ABSearchOrder(58) = &H00
	ABSearchOrder(59) = &H00
	ABSearchOrder(60) = &H00
	ABSearchOrder(61) = &H00
	ABSearchOrder(62) = &H00
	ABSearchOrder(63) = &H00
	ABSearchOrder(64) = &Hfe
	ABSearchOrder(65) = &H42
	ABSearchOrder(66) = &Haa
	ABSearchOrder(67) = &H0a
	ABSearchOrder(68) = &H18
	ABSearchOrder(69) = &Hc7
	ABSearchOrder(70) = &H1a
	ABSearchOrder(71) = &H10
	ABSearchOrder(72) = &He8
	ABSearchOrder(73) = &H85
	ABSearchOrder(74) = &H0b
	ABSearchOrder(75) = &H65
	ABSearchOrder(76) = &H1c
	ABSearchOrder(77) = &H24
	ABSearchOrder(78) = &H00
	ABSearchOrder(79) = &H00
	ABSearchOrder(80) = &H03
	ABSearchOrder(81) = &H00
	ABSearchOrder(82) = &H00
	ABSearchOrder(83) = &H00
	ABSearchOrder(84) = &H03
	ABSearchOrder(85) = &H00
	ABSearchOrder(86) = &H00
	ABSearchOrder(87) = &H00
'Contacts ID 1, length 16 (from 01023d01 (0..15) -> 01026601)
	sKeyPath = strRegistryFolder & "\" & contactskey & "\"	
	objRegistry.getBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026601", Contacts
	For n = 88 To 103
		ABSearchOrder(n) = Contacts(n - 88)
	Next
'Contacts ID 1 end	
'Contacts ID 2, length 48 (from 01023d01 (0..15) -> 11026620 (12..59))
	objRegistry.getBinaryValue HKEY_CURRENT_USER, sKeyPath, "11026620", Contacts
	For n = 104 To 151
		ABSearchOrder(n) = Contacts(n - 92)
	Next
'Contacts ID 2 end
	ABSearchOrder(152) = &H00
	ABSearchOrder(153) = &H00
	ABSearchOrder(154) = &H00
	ABSearchOrder(155) = &H00
'LDAP Adress Book ID, length 16
	ABSearchOrder(156) = &H50
	ABSearchOrder(157) = &Ha7
	ABSearchOrder(158) = &H0a
	ABSearchOrder(159) = &H61
	ABSearchOrder(160) = &H55
	ABSearchOrder(161) = &Hde
	ABSearchOrder(162) = &Hd3
	ABSearchOrder(163) = &H11
	ABSearchOrder(164) = &H9d
	ABSearchOrder(165) = &H60
	ABSearchOrder(166) = &H00
	ABSearchOrder(167) = &Hc0
	ABSearchOrder(168) = &H4f
	ABSearchOrder(169) = &H4c
	ABSearchOrder(170) = &H8e
	ABSearchOrder(171) = &Hfa
'LDAP Adress Book ID end
	ABSearchOrder(172) = &H01
	ABSearchOrder(173) = &H04
	ABSearchOrder(174) = &H00
	ABSearchOrder(175) = &H00
	ABSearchOrder(176) = &Hfe
	ABSearchOrder(177) = &Hff
	ABSearchOrder(178) = &Hff
	ABSearchOrder(179) = &Hff
	ABSearchOrder(180) = &H00
	ABSearchOrder(181) = &H75
	ABSearchOrder(182) = &H72
	ABSearchOrder(183) = &H62
	ABSearchOrder(184) = &H6f
	ABSearchOrder(185) = &H6b
	ABSearchOrder(186) = &H2e
	ABSearchOrder(187) = &H62
	ABSearchOrder(188) = &H65
	ABSearchOrder(189) = &H72
	ABSearchOrder(190) = &H2e
	ABSearchOrder(191) = &H6d
	ABSearchOrder(192) = &H79
	ABSearchOrder(193) = &H74
	ABSearchOrder(194) = &H6f
	ABSearchOrder(195) = &H79
	ABSearchOrder(196) = &H73
	ABSearchOrder(197) = &H2e
	ABSearchOrder(198) = &H64
	ABSearchOrder(199) = &H65
	ABSearchOrder(200) = &H00
	ABSearchOrder(201) = &H00
	ABSearchOrder(202) = &H00
	ABSearchOrder(203) = &H00
	sKeyPath = strRegistryFolder & "\" & "9207f3e0a3b11019908b08002b2a56c2\"
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "11023d05", ABSearchOrder
'Append to Backup Key for ldap connection settings
	sKeyPath = strRegistryFolder & "\" & "9207f3e0a3b11019908b08002b2a56c2\"
	objRegistry.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
	objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d0e", Backup
'Delete Active Books List Key
	sKeyPath = strRegistryFolder & "\" & "9375CFF0413111d3B88A00104B2A6676"
	objRegistry.DeleteValue HKEY_CURRENT_USER, sKeyPath, "{ED475419-B0D6-11D2-8C3B-00104B2A6676}"
End Function 'CreateAccount


modified 15-Jun-17 11:00am.

NewsDelete Active Books List Key not working Pin
nacken200821-May-17 11:18
Membernacken200821-May-17 11:18 
NewskeyNames of Ldap Type Key for Office 2016 Pin
nacken200815-Jun-17 5:35
Membernacken200815-Jun-17 5:35 
QuestionMore then one address book with a script? Pin
Member 1273722313-Sep-16 2:46
MemberMember 1273722313-Sep-16 2:46 
QuestionRegistry check before proceeding Pin
virt3x22-Feb-12 13:34
Membervirt3x22-Feb-12 13:34 
GeneralOutlook version & more Pin
cdclark1-Jun-06 12:10
Membercdclark1-Jun-06 12:10 
GeneralRe: Outlook version & more Pin
Roland Hordos16-Apr-07 8:26
MemberRoland Hordos16-Apr-07 8:26 
GeneralRe: Outlook version & more Pin
Oleg Ivanilov18-Oct-12 19:52
MemberOleg Ivanilov18-Oct-12 19:52 
SuggestionRe: Outlook version & more Pin
nacken200820-May-17 7:54
Membernacken200820-May-17 7:54 
GeneralLDAP Addition Pin
ggonsalv8-May-06 19:42
Memberggonsalv8-May-06 19:42 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.