Deleting an Existing Contact with CDOEX (Visual Basic)

Topic Last Modified: 2006-06-12

Example

Visual Basic

Note

The following example uses a file URL with the Exchange OLE DB (ExOLEDB) provider. The ExOLEDB provider also supports The HTTP: URL Scheme. Using The HTTP: URL Scheme allows both client and server applications to use a single URL scheme.

' Deleting an Existing Contact with CDOEx

Sub DeleteContact(sDeleteName As String, sMailbox As String)

Dim oRec As ADODB.Record
Dim sURL As String
Dim sSQL As String
Dim oRst As ADODB.Recordset
Dim sHREF As String
Dim sDomainName As String
Dim sLocalPath As String
Dim sMailbox As String
Dim sDeleteName As String
Dim bFound As Boolean
Dim oAdSysInfo As ActiveDs.ADSystemInfo

Set oAdSysInfo = CreateObject("ADsystemInfo")
sDomainName = oAdSysInfo.DomainDNSName

' Specify a URL to the contacts folder or a contact item.
sLocalPath = "MBX\" & sMailbox & "\contacts"

Set oRec = CreateObject("ADODB.Record")
Set oRst = CreateObject("ADODB.Recordset")

sURL = "file://./backofficestorage/" & sDomainName & "/" & sLocalPath
oRec.Open sURL

' Create the SQL query for the recordset.
sSQL = "select "
sSQL = sSQL & " ""urn:schemas:mailheader:content-class"""
sSQL = sSQL & ", ""DAV:href"""
sSQL = sSQL & ", ""DAV:displayname"""
sSQL = sSQL & " from scope ('shallow traversal of " & Chr(34)
sSQL = sSQL & sURL & """') "
sSQL = sSQL & " WHERE ""DAV:ishidden"" = false"

' Open the recordset, a list of folders and/or items.
oRst.Open sSQL, oRec.ActiveConnection
bFound = False
Do While Not oRst.EOF
    Dim oPer As New cdo.Person
    Dim sRecordSource As String
    Dim sNameToDelete As String
    sRecordSource = oRst.Fields("DAV:href")
    oPer.DataSource.Open sRecordSource, , adModeReadWrite
    sNameToDelete = oPer.FirstName
    sNameToDelete = sNameToDelete & IIf((oPer.MiddleName = ""), " ", " " & oPer.MiddleName & " ")
    sNameToDelete = sNameToDelete & oPer.LastName
    If Trim(UCase(sNameToDelete)) = UCase(sDeleteName) Then
        bFound = True
        oRst.Delete
        Exit Do
    End If
    oRst.MoveNext
    Set oPer = Nothing
Loop
If Not bFound Then
    Debug.Print sDeleteName & ": No such contact found to delete. Please check the name again."
End If
End Sub