How to create an Offline Address Book using Visual Basic
I thought that this would be fun to post, so here it is :)
'//////////////////////////////////////////////////////////////////////
' Function: createOfflineAddressBook()
' Purpose: Creates an Offline Address Book. '
' Input: szDomainName: Domain of the Exchange org
' szOrganizationName: Name of Exchange org
' szAddressName: Name of address book
' szDomain: Domain suffix ' szUserName: admin username
' szUserPwd: admin pwd ' szDirectoryServer: Name of the Directory Server
' szAdminGroup: Name of the Admin Group '
' Output: createOfflineAddressBook: Contains Error code (if any) '
' Note: In order for this example to function correctly, it may be necessary to include
' references to the following libraries: Active DS Type Library, Microsoft CDO for ' Exchange Management Library, Microsoft Cluster Service Automation Classes,
' Microsoft CDO for Windows 2000 Library.
'//////////////////////////////////////////////////////////////////////
Public Function createOfflineAddressBook(ByVal szDomainName As String, _ ByVal szOrganizationName As String, _ ByVal szAddressName As String, _ ByVal szDomain As String, _ ByVal szUserName As String, _ ByVal szUserPwd As String, _ ByVal szDirectoryServer, _ ByVal szAdminGroup) As Integer
Dim objLdap As IADsOpenDSObject
Dim objOAB As IADs
Dim objOABContainer As IADsContainer
Dim szLdapDomain As String
Dim szConnString As String
Dim szSiteFolderServer As String
Dim szAddressBookLocation As String
Dim baSchedule(83) As Byte
Dim szaOfflineABSServer() As String
Dim szOfflineABServer As String
Dim iIndex As Integer
Dim baGuidArray(15) As Byte
Dim szaDomTokens() As String
Dim szDomainDN As String
Dim iIndex As Integer
Dim iCounter As Integer
Dim szChar As String
Dim bConv As Byte
Dim szGuid As String On Error GoTo errhandler
' Puts the domain specified into an ldap domain string.
szaDomTokens = Split(szDomainName, ".", -1, 1) szDomainDN = Join(szaDomTokens, ",dc=")
szDomainDN = "dc=" & szDomainDN szLdapDomain = szDomainDN
' Fill in byte array, this is expensive but it's only called once per ' hosted org creation.
For iIndex = LBound(baSchedule) To UBound(baSchedule)
Select Case iIndex
Case 6
baSchedule(iIndex) = 8
Case 18
baSchedule(iIndex) = 8
Case 30
baSchedule(iIndex) = 8
Case 42
baSchedule(iIndex) = 8
Case 54
baSchedule(iIndex) = 8
Case 66
baSchedule(iIndex) = 8
Case 78
baSchedule(iIndex) = 8
Case Else baSchedule(iIndex) = 0
End Select
Next
' Location of address book.
szAddressBookLocation = "cn=" + szAddressName + _ ",cn=All Global Address Lists,cn=Address Lists Container,cn=" + _ szOrganizationName + ",cn=microsoft exchange,cn=services,cn=configuration," + _ szLdapDomain
' Get the site server string.
szConnString = "LDAP://" + szDirectoryServer + "/" + _ "cn=" + szAdminGroup + ",cn=Administrative Groups,cn=" + _ szOrganizationName + ",cn=Microsoft Exchange,CN=Services,CN=Configuration," + _ szLdapDomain
' On the Admin group object, get the site folder server value.
getValue szConnString, "siteFolderServer", szSiteFolderServer, szUserName, szUserPwd
' The offlineABServer is the sitefolderserver minus the first four entries,' so when putting the ‘szOfflineABSServer string together, start indexing at 4.
szaOfflineABSServer = Split(szSiteFolderServer, "cn=", -1, 1)
szOfflineABServer = ""
For iIndex = 4 To UBound(szaOfflineABSServer)
szOfflineABServer = szOfflineABServer + "cn=" + szaOfflineABSServer(iIndex)
Next
' Open up the directory with the passed credentials (preferably the admin).
' Create a connection string for the offline address book.
szConnString = "LDAP://" + szDirectoryServer + "/" + _ "CN=Offline Address Lists,CN=Address Lists Container,CN=" + _ szOrganizationName + ",CN=Microsoft Exchange,CN=Services,CN=Configuration," + _ szLdapDomain Set objLdap = GetObject("LDAP:")
' Create object and get FID.
Set objOABContainer = objLdap.OpenDSObject(szConnString, _ szUserName, _ szUserPwd, _ ADS_SECURE_AUTHENTICATION)
' Create the recipient policy object.
Set objOAB = objOABContainer.Create("msExchOAB", _ "cn=" + szAddressName)
' Set required properties and Take the string guid and get the guid as a hex byte array.
szGuid = GetGUID
iIndex = 0
For iCounter = 1 To Len(szGuid) Step 2
' Get the current character.
szChar = Mid(szGUID, iCounter, 2)
' Convert the character to it's hex value.
bConv = getByteValue(szChar)
' Stick that hex value into the byte array.
baGuidArray(iIndex) = bConv
iIndex = iIndex + 1
Next
With objOAB
.Put "name", szAddressName
.Put "showInAdvancedViewOnly", True
.Put "systemFlags", 1610612736
.Put "doOABVersion", 0
.Put "msExchOABFolder", 0
.Put "offLineABContainers", szAddressBookLocation
.Put "offLineABSchedule", baSchedule
.Put "offLineABServer", szOfflineABServer
.Put "offLineABStyle", 1
.Put "siteFolderGUID", baGuidArray
.Put "siteFolderServer", szSiteFolderServer
.Put "legacyExchangeDN", "/o=" + szOrganizationName + "/cn=addrlists/cn=oabs/cn=" + szAddressName
.SetInfo End With createOfflineAddressBook = 0
' Clean up.
Set objLdap = Nothing
Set objOAB = Nothing
Set objOABContainer = Nothing
Exit Function
' Error handling. errhandler:
Set objLdap = Nothing
Set objOAB = Nothing
Set objOABContainer = Nothing
createOfflineAddressBook = 1
' Implement error logging here.
Exit Function
End Function
Dave