Sync AD with Exchange Public Folder

after a call to PSS, a friend has received this code to sync an Exchange Public Folder with AD. This approach is to open Outlook (CreateObject), and control it programmatically.
Language:
VBScript
Keywords:
VBScript
Code Snippet

 

'Script to create Outlook contact objects from AD.
'Schedule to run nightly.
'05.27.04 Westdale Asset Management
'Originally created by Microsoft Corporation PSS
'Script assumes you have a contacts folder named 'contacts' in public folders.
 
Set rootDSE = GetObject("LDAP://rootDSE")
 
BaseDN = rootDSE.Get("defaultNamingContext")
 
Set oCon = CreateObject("ADODB.Connection")
oCon.Provider = "ADsDSOObject"
oCon.Open "DS Query"
 
Set cmdAllUsers = CreateObject("ADODB.Command")
Set cmdAllUsers.ActiveConnection = oCon
cmdAllUsers.CommandText = "<LDAP://" & BaseDN & ">;(&(objectCategory=person)(objectClass=user));AdsPath;subTree"
 
Set oRst = cmdAllUsers.Execute
 
If oRst.RecordCount > 0 Then

    Set olApp = CreateObject("Outlook.Application")
 
    numItems = olApp.GetNamespace("MAPI").GetDefaultFolder(18).Folders.Item("WAM Address List").Items.Count
    For i=1 to numItems
        olApp.GetNamespace("MAPI").GetDefaultFolder(18).Folders.Item("WAM Address List").Items(1).delete
    Next
 
    oRst.MoveFirst
    Do While Not oRst.EOF

        Set oUser = GetObject(oRst.Fields("AdsPath"))

        Set Contact = olApp.GetNamespace("MAPI").GetDefaultFolder(18).Folders.Item("WAM Address List").Items.Add

        Contact.FirstName = oUser.givenname
        Contact.LastName = oUser.sn
        Contact.MiddleName = oUser.Initials
        Contact.Email1Address = oUser.mail
        Contact.HomeTelephoneNumber = oUser.homePhone
        Contact.BusinessAddressStreet = oUser.streetAddress
        Contact.BusinessAddressCity = oUser.l
        Contact.BusinessAddressPostalCode = oUser.postalCode
        Contact.BusinessAddressState = oUser.st
        Contact.BusinessAddressCountry = oUser.co
        Contact.BusinessTelephoneNumber = oUser.telephoneNumber
        Contact.BusinessFaxNumber = oUser.facsimileTelephoneNumber
        Contact.PagerNumber = oUser.pager
        Contact.CompanyName = oUser.department
        Contact.JobTitle = oUser.Title
        Contact.Department = oUser.Department
        Contact.OfficeLocation = oUser.physicalDeliveryOfficeName
        Contact.Email1DisplayName = oUser.DisplayName
        Contact.MobileTelephoneNumber = oUser.mobile
        Contact.Save
 
        oRst.MoveNext
    Loop

    WScript.Echo "All records are updated"

    Set oUser = Nothing
    Set Contact = Nothing
 
End If

 


Created 2012-01-25
comments powered by Disqus
Login