OC.CPRebuild: Sync AD phone with CISCO Unity

Author: Robert Lawson
Environment: Windows Server, Access/VBA, Microsoft SQL Server, Exchange
Description: This code is part of the Active Directory and Cisco Unity phone number synchronization. This code establishes the relationship between the AD account and the Unity voicemail number, which is considered the same as phone number. The results are then compared, in another piece of code, to the existing phones number. If the old phone number is not set, then this is considered a newly established phone number and an introductory email is sent to the user: see OC.SendAppMail.
Features
- Phone number shows in Exchange email address book
- Converts 4 digit extension into common format with area code: aaa-ppp-dddd
- Newly assigned phone number initiates introductory email to user.
Code:

Public Sub CPRebuild(intStatus As Integer)
' Rebuild the phone table

' intStatus            Returned    0=OK, <>0 You're not OK

On Error GoTo ErrorBegin
Dim strName As String
strName = "CPRefresh"

' Local
Dim con As ADODB.Connection
Dim Com As ADODB.Command
Dim rx As ADODB.Recordset
Dim strDomain As String
Dim strsamAccountName As String, strSMTPUser As String
Dim Kount As Double

intStatus = 0 ' I'm OK
If Not bolDBSetup Then Call CPSetup

Set con = CreateObject("ADODB.Connection")
Set Com = CreateObject("ADODB.Command")
'Opening the connection
con.Provider = "ADsDSOObject"  'this is the ADSI OLE-DB provider name
con.Open "Active Directory Provider"
Set Com.ActiveConnection = con 'Create a command object for this connection

strSQL = "SELECT * FROM CampusPhoneDetail"
Debug.Print strSQL
Set objRS = CreateObject("ADODB.Recordset")
objRS.Open strSQL, conDbOneCard, adOpenStatic, adLockPessimistic ' write access
With objRS

' ciscoEcsbuTransferId = transferid, ciscoEcsbuDtmfId=extension
' strNETADDomain = "OU=Users,OU=Aliso Viejo,DC=soka,DC=edu"
' only get those with an extension
strSQL = "SELECT samAccountName, employeeID, ciscoEcsbuDtmfId" & _
" FROM 'LDAP://" & strNETADDomain & "'" & " WHERE ciscoEcsbuDtmfId = '*' AND homeMDB='*'"

Debug.Print strSQL
Com.CommandText = strSQL
Set rx = Com.Execute

Kount = 0
If (rx.BOF Or rx.EOF) Then
    intStatus = 10
    strMessage = strName & ": no extensions found in Active directory."
    GoTo ErrorBegin
End If

Do While Not (rx.BOF Or rx.EOF)
    Kount = Kount + 1
    strExtension = Trim(Nz(rx.Fields("ciscoEcsbuDtmfId"), ""))
    strNETUser = Nz(rx.Fields("samAccountName"), "")
    ' Debug.Print "samAccountName " & rx.Fields("samAccountName")
    If Len(Trim(strExtension)) > 0 Then  ' Only get Unity extensions
        strNETUser = Nz(rx.Fields("samAccountName"), "")
        strID = Nz(rx.Fields("employeeID"), "")
      
        Call CPPhone(intStatus) ' CRule, Extension, PhoneNumber
        If intStatus = -2 Then
            ' OK, just not classified, but error was reported, keep on truckin'
        ElseIf intStatus <> 0 Then
            intStatus = 22
            strMessage = strName & ": CPPhone failed on NETUser = " & strNETUser
            GoTo ErrorBegin
        End If
        .AddNew
        !NETUser = strNETUser
        !ID = strID
        !CRule = strCRule
        !Extension = strExtension
        !PhoneNumber = strPhoneNumber
        .Update
    End If
    rx.MoveNext
Loop
End With
Set objRS = Nothing
rx.Close

ExitBegin:
    Debug.Print "End of " & strName & " proceseed records: " & Kount
    Exit Sub

ErrorBegin:
    If intStatus = 0 Then ' General message
        strMessage = "Error in " & strName & " " & Err.Number & " " & Err.Description
        intStatus = -100 ' I'm NOT OK
    End If
    If bolOnLine Then MsgBox strMessage
    Call DoEventLog("ERR", strName, 500, strMessage, True, bolOnLine)
    GoTo ExitBegin
End Sub