Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As Byte) As Long
Private Sub Form_Load()
Dim tSchedule(0 To 83) As Byte
Dim tGUID(0 To 15) As Byte
Dim lTemp(0) As Byte
Dim byteArray(0) As Variant
Dim sOrgName, sContainerDN, sOABName, sExchServer, sLegacyExchangeDN, sPublicFolder, sDescription
Dim iOABStyle, idoOABVersion
Dim sSystemFlags
Dim bOABDefault
' Get the configuration name space
Set oRootDSE = GetObject("LDAP://RootDSE")
strConfigNC = oRootDSE.Get("configurationNamingContext")
Set oRootDSE = Nothing
' You MUST modify these values based on your environment
sOrgName = "MyOrganization"
sServerName = "MyExchangeServer"
sContainerDN = "CN=Offline Address Lists,CN=Address Lists Container,CN=" & sOrgName & ",CN=Microsoft Exchange,CN=Services," & strConfigNC
sOABName = "NewOAB"
sOABContainers = Array( _
"CN=All Users,CN=All Address Lists,CN=Address Lists Container,CN=" & sOrgName & ",CN=Microsoft Exchange,CN=Services," & strConfigNC, _
"CN=Default Global Address List,CN=All Global Address Lists,CN=Address Lists Container,CN=" & sOrgName & ",CN=Microsoft Exchange,CN=Services," & strConfigNC _
)
sExchServer = "CN=" & sServerName & ",CN=Servers,CN=First Administrative Group,CN=Administrative Groups,CN=" & sOrgName & ",CN=Microsoft Exchange,CN=Services," & strConfigNC
idoOABVersion = 0
iOABStyle = 2
sLegacyExchangeDN = "/o=" & sOrgName & "/cn=addrlists/cn=oabs/cn=" & sOABName
bOABDefault = False
sSystemFlags = "1610612736"
sPublicFolder = "CN=Public Folder Store (" & sServerName & "),CN=First Storage Group,CN=InformationStore,CN=" & sServerName & ",CN=Servers,CN=First Administrative Group,CN=Administrative Groups,CN=" & sOrgName & ",CN=Microsoft Exchange,CN=Services," & strConfigNC
sDescription = "This is a test"
vSchedule = tSchedule
' Build Legacy Exchange distinguished name
sLegacyExchangeDN = "/o=" & sOrgName & "/cn=addrlists/cn=oabs/cn=" & sOABName
' Generate a GUID for each OAB that is created
hr = CoCreateGuid(tGUID(0))
If hr <> 0 Then
Debug.Print "Error " & Err.Number & " calling CoCreateGUID"
End
End If
vGUID = tGUID
' Create the variant array of byte arrays set to 0x00 for msExchOABFolder
lTemp(0) = CByte(0)
byteArray(0) = lTemp
'Creating the actual Offline Address Book
'Binding to the container based on the DN passed (the container where all the offline address books exist
Set oContainer = GetObject("LDAP://" & sContainerDN)
Set oNewOAB = oContainer.Create("msExchOAB", "cn=" & sOABName)
'The following attributes are required for the object to be created in the active directory
'Its the list of Address Lists that should be included in this OAB
oNewOAB.PutEx ADS_PROPERTY_UPDATE, "offlineABContainers", sOABContainers
'Need to research this further, can we have exchange 5.5 servers in it, do they have to have and ADC?
'DN of the Exchange Server responsible for generating this OAB
oNewOAB.Put "offlineABServer", sExchServer
'doOABVersion is a mandatory attribute that can be set to:
' 0 = if compatibility with 4.0 and 5.0 is not required;
' 1 = if the OAB should be compatible with 4.0 and 5.0;
' all other values are reserved for future use.
' defaults to 0 when OAB create from Exchange System Manager
oNewOAB.Put "doOABVersion", idoOABVersion
'A must-contain attribute in the schema due to legacy versions but it is no longer in use.
'Sets it to a zeroed byte.
oNewOAB.PutEx ADS_PROPERTY_UPDATE, "msExchOABFolder", byteArray
'A 84 byte array that stores the Exchange schedule
'Each bit in this structure represents a 15 minutes increment starting from 12am Sunday
'Each byte in this structure represents 2 hour increments
'Set the bit to 1 to indicate the schedule to run at this 15 minute interval
oNewOAB.Put "offlineABSchedule", vSchedule
'Indicates a more general exchange schedule and based on its value the exchange schedule is set to
'run never, always or based on the custom schedule stored in offlineABSchedule
'0 = Never. This is the same as having the schedule blob full of 0x00.
'1 = Run as specified by the offLineABSchedule blob
'2 = Run Always. This is the same as having the schedule blob full of 0xFF.
oNewOAB.Put "offlineABStyle", iOABStyle
'The following need not be set for the object creation in the AD, but they do need to be set
'for proper working of the Offline Address Book
'It should be derived from the legacyExchangeDN of the organization.
'ESM creates it as "<legacyDN of the Org>/cn=addrlists/cn=oabs/cn=<legacy CN for the oab>".
oNewOAB.Put "legacyExchangeDN", sLegacyExchangeDN
'When a new Mailbox Store is created, the OAB that contains msExchOABDefault set to TRUE
'is automatically selected and users on that store will use that OAB.
'Only one OAB should have this attribute set to TRUE. When changing it, remove it from all the other OABs.
oNewOAB.Put "msExchOABDefault", bOABDefault
'This can only be set at creation time
'This attribute is set by passing a value that is defined by the ADS_SYSTEMFLAG_ENUM enumeration documented at -
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/netdir/adsi/ads_systemflag_enum.asp
'In this sample I am passing in the 1610612736 (0x60000000) which is
'0x60000000 = 0x40000000 or 0x20000000 (ADS_SYSTEMFLAG_CONFIG_ALLOW_RENAME + ADS_SYSTEMFLAG_CONFIG_ALLOW_MOVE)
oNewOAB.Put "systemFlags", sSystemFlags
'set it to a random GUID for the OAB.
oNewOAB.Put "siteFolderGUID", vGUID
'DN of the Public Folder Store where the OAB should be stored.
'It should be in the same server of offLineABServer to avoid network traffic.
oNewOAB.Put "siteFolderServer", sPublicFolder
'The following properties are optional and do not have to be set.
'This is basically what you see under the Details tab from Exchange System Manager
'when you create a new OAB
If (sDescription <> "") Then
oNewOAB.Put "adminDescription", sDescription
End If
' Write object to the directory
oNewOAB.SetInfo
' Clean Up
Set oNewOAB = Nothing
Set oContainer = Nothing
End Sub