Problem in Adding Contacts

From: "asrao" <asrao@xxxxxxxxxxxxxxxx>
To: <exchangelist@xxxxxxxxxxxxx>
Date: Sat, 13 Jul 2002 18:57:48 +0530

Hello,

        I using the below service for adding contacts to the Exchange server 
2000 which is running on Windows 2000 server. My problem is that I able to do 
it using this service from Visual Basic. But when I add an Contact for a user 
from WAP it is not adding and taking long time and after some time giving an 
message saying that 'Network not available' in the UP Simulator. And even when 
I test the same page in IE, there is no response. The funny thing here is that 
it is working from VB Source code but not from WAP or in IE. Can any one please 
help me out in solving this issue.



Thanks

ASRao
Applabs(India)


===================================================================================================
'' Name             : AddContact
'' Description      : To add a contact to a user
'' Author           : Maruthi Krishna
'' Inputs           : Backend server name, user name, contact first name, 
contact last name,
''                    contact lstrEmailId, contact home phone, contact 
lstrContactMobileNo,contact home address
''                    contact work address
'' Outputs          : N/A
'' Modified by      : ASRao
'' Modified Reason  : Coding standards and validations
'' 
===================================================================================================
Public Function AddContact(ByVal lstrUserId As String, ByVal lstrPassword As 
String, _
                ByVal lstrBackEndServerName As String, ByVal 
lstrContactFirstName As String, _
                ByVal lstrContactLastName As String, ByVal lstrContactHomePhone 
As String, _
                ByVal lstrContactMobileNo As String, ByVal lstrContactEmailId 
As String, _
                ByVal lstrContactHomeAddrs As String, ByVal 
lstrContactWrkgAddrs As String) As Boolean
        
    '' Local variables
    Dim lobjPerson As New CDO.Person    '' To hold the Person object
    Dim lstrContactURL As String        '' To hold the contact URL
    Dim lrecMailBoxURL As ADODB.Record
    Dim lstrMailBoxURL As String
    Dim lobjConn As New ADODB.Connection
    Dim lstrProvider As String
    '' Set Error handler
    On Error GoTo ErrHandler
    
    Set lrecMailBoxURL = CreateObject("ADODB.Record")
    
    '' Set mailbox url string
    lstrMailBoxURL = "http://"; & lstrBackEndServerName & "/exchange/" & 
lstrUserId
    '' Open the record for the specified mailbox url
    lrecMailBoxURL.Open lstrMailBoxURL, , , , , lstrUserId, lstrPassword
    '' Set contact url string
    lstrContactURL = lrecMailBoxURL.Fields("urn:schemas:httpmail:contacts")
    '' Capturing the active connection
    lstrProvider = lrecMailBoxURL.ActiveConnection
    '' Closing the record object
    lrecMailBoxURL.Close
    '' opening the connection for the user using the provider
    lobjConn.Open lstrProvider, lstrUserId, lstrPassword
    '' adding contact details to the userid
    With lobjPerson
        .FirstName = lstrContactFirstName
        .LastName = lstrContactLastName
        .HomePhone = lstrContactHomePhone
        .MobilePhone = lstrContactMobileNo
        .Email = lstrContactEmailId
        .HomeState = lstrContactHomeAddrs
        .WorkState = lstrContactWrkgAddrs
        '' changed by asrao on 09.Jul.2002
''       .DataSource.Open lstrContactURL, , , , , lstrUserId, lstrPassword
        .DataSource.SaveToContainer lstrContactURL, lobjConn
    End With
    '' returning the function value as 'True' if successfull
    AddContact = True

    Exit Function

ResumeHere:
    '' setting the record object to nothing
    If Not lobjPerson Is Nothing Then
        Set lobjPerson = Nothing
    End If
    If Not lobjConn Is Nothing Then
        Set lobjConn = Nothing
    End If
    If Not lrecMailBoxURL Is Nothing Then
        Set lrecMailBoxURL = Nothing
    End If
    
    Exit Function
        
ErrHandler:
    '' calling the function to write the errors occured to a log file
    Call WriteIntoErrLogFile(Err.Number, Err.Description, "AddContact")
    'Shell ("net send 172.16.1.98 " & Err.Description)
    '' set the function return value as 'False'
    AddContact = False
    '' continuing the execution by passing the control to ResumeHere label
    Resume ResumeHere
End Function
Problem in Adding Contacts

Other related posts:
