' From the book "Active Directory, Third Edition" 
' ISBN: 0-596-10173-2

Option Explicit
   
'**********************************************************************
'Force error checking within the code using the Err.Number property
'method in approaches 2 and 3
'**********************************************************************
On Error Resume Next
   
'**********************************************************************
'Declare the constants and variables
'**********************************************************************
Const ADSTYPE_CASE_IGNORE_STRING = 3
Const ADS_PROPERTY_UPDATE = 2
   
Dim objPropValue  'An ADSI PropertyValue object
Dim objPropEntry  'An ADSI PropertyEntry object
Dim objUser       'The user whose property list you want to investigate
Dim strText       'A text string that displays results in one message box
Dim intPropCount  'The number of properties
Dim intIndex      'The index used while looping through the property list
   
Set objUser = GetObject("LDAP://cn=AlistairGLN,ou=Sales,dc=mycorp,dc=com")
objUser.GetInfo
   
'**********************************************************************
'Section A: Calculate the property count, and enumerate each 
'property's name and datatype
'**********************************************************************
intPropCount = objUser.PropertyCount
WScript.Echo "There are " & intPropCount _
  & " values in the property cache before adding the new one."
   
strText = ""
For intIndex = 0 To (intPropCount-1)
  strText = strText & objUser.Item(intIndex).Name & vbTab _
    & objUser.Item(intIndex).ADsType & vbCrLf
Next
WScript.Echo strText
   
'**********************************************************************
'Section B: Create a property entry, and write it to the cache
'**********************************************************************
Set objPropValue = CreateObject("PropertyValue")
objPropValue.ADsType = ADSTYPE_CASE_IGNORE_STRING
objPropValue.CaseExactString = "0123-456-7890"
   
Set objPropEntry = CreateObject("PropertyEntry")
objPropEntry.Name = "pager"
objPropEntry.Values = Array(objPropValue)
objPropEntry.ADsType = ADSTYPE_CASE_IGNORE_STRING
objPropEntry.ControlCode = ADS_PROPERTY_UPDATE
   
objUser.PutPropertyItem(objPropEntry)
   
'**********************************************************************
'Section C: Write out the cache to Active Directory and read the new
'cache explicitly back in from the object
'**********************************************************************
objUser.SetInfo
objUser.GetInfo
   
'**********************************************************************
'Section D: Recalculate the property count, and re-enumerate each
'property's name and datatype to see the changes
'**********************************************************************
intPropCount = objUser.PropertyCount
   
WScript.Echo "There are " & intPropCount _
  & " values in the property cache after adding the new one."
   
strText = ""
For intIndex = 0 To (intPropCount-1)
  strText = strText & objUser.Item(intIndex).Name _
    & vbTab & objUser.Item(intIndex).ADsType & vbCrLf
Next
WScript.Echo strText