Calling an XML Web Service from an Outlook Form

One feature you might want to take advantage of in your Outlook forms is the ability to call XML Web services. To do this, you should be familiar with the Visual Studio 6.0 SOAP toolkit. Because Outlook uses VBScript, the easiest way to call an XML Web service from an Outlook form is to use the COM component SOAP client that ships with the toolkit.

To show how to call a Web service, I've updated the Account Tracking application to use the free/busy XML Web service that you will learn about in Chapter 14. Before we can use the XML Web service, we must determine the SMTP address of the sales representative in the Account Team section of the Account Tracking application. To do this, we need to use CDO within Outlook. The CDO code for finding an SMTP address from a CDO AddressEntry object is shown next . Notice the use of the PR_EMS_AB_PROXY_ADDRESSES property, which contains the SMTP address as well as the X.400 and other addresses for the user .

 Function FindSMTP(oAE)     'Finds the SMTP address if the user     On Error Resume Next     Err.Clear     EmailAddresses = oAE.Fields.Item(PR_EMS_AB_PROXY_ADDRESSES)     Count = UBound(EmailAddresses)     For i = LBound(EmailAddresses) To Count         'Because there is probably SMTP, X.400, etc, find just SMTP         If (instr(1,EmailAddresses(i),"SMTP:") = 1) Then             'Strip out SMTP:             strSMTP = mid(EmailAddresses(i),6)             'Now, strip out everything up to the @ symbol             AtSymbol = InStr(1,strSMTP,"@")             If AtSymbol > 1 Then                 'Found it                 strSMTP = Mid(strSMTP, 1, ((AtSymbol)-1))                 'Figure out the properties from the address book                 FindSMTP = strSMTP             End If         End If     Next End Function 

The next step is to call our Web service. We'll use the MSSOAP.SoapClient30 library to make the call. This client does the heavy lifting of wrapping our SOAP calls and our SOAP responses, plus it is a COM component, so no interop is required between .NET and COM in our code. The code initializes the SOAP client with pointers to the WSML and WSDL files for the free/busy Web service. Then the code gets the SMTP address of the user and calls the GetFreeBusy method on the Web service.

The code takes the response and passes it to the CheckFB function shown next. The CheckFB function takes the free/busy string returned by the Web service and parses the string to determine the sales rep availability over the next hour and returns it to the user.

 Sub cmdLookupRepFreeBusy_Click    On Error Resume Next    Err.Clear         If oDefaultPage.Controls("txtSalesRep").value = "" Then       MsgBox "You must enter a value before checking free/busy"       Exit Sub    End If    'Initialize the SOAP Client    Set oSoapClient = CreateObject("MSSOAP.SoapClient30")    oSoapClient.mssoapinit strWSDLLocation,,, strWSMLLocation    Set oCDOSession = application.CreateObject("MAPI.Session")    oCDOSession.Logon "", "", False, False, 0    'Create a bogus message    'Try to find the recipient in the address book by their    'alias by sending a message    Set otmpMessage = oCDOSession.Outbox.Messages.Add    otmpMessage.Recipients.Add oDefaultPage.Controls("txtSalesRep").Value    otmpMessage.Recipients.Resolve    If otmpMessage.Recipients.Resolved <> True Then       MsgBox "The name could not be resolved."    Else       'Get the SMTP address of the user       Set orecip = otmpMessage.Recipients.Item(1)       'Populate the other fields as necessary       Set oAE = oCDOSession.GetAddressEntry(orecip.AddressEntry.ID)       strSMTP = FindSMTP(oAE)       Set otmpMessage = Nothing            dNow = Now       strStartDate = Month(dNow) & "/" & Day(dNow) & "/" & _                      Year(dNow) & " 12:00 AM"            strEndDate = Month(dNow) & "/" & Day(dNow) & "/" & _                    Year(dNow) & " 11:59 PM"            strServerResponse = oSoapClient.GetFreeBusy(strLDAPDirectory, _                           strSMTP, strStartDate, strEndDate, "30")            'Scroll through the response and add it to the listbox       Dim arrResponse       arrResponse = Split(strServerResponse, ",")       For i = LBound(arrResponse) To UBound(arrResponse)          'Get the full hour from the current time          dNextStartDate = FormatDateTime(dNow, 2) & " " & _                           FormatDateTime(Hour(dNow) & ":00", 3)               'The end time should be the end of the day          dNextEndDate = FormatDateTime(DateAdd("h",1,dNextStartDate),0)          strFBResponse = CheckFB(arrResponse(i),strStartDate, _                          dNextStartDate,dNextEndDate, "Sales Rep")          oDefaultPage.Controls("lblSalesFreeBusy").Caption = strFBResponse       Next    End If    Set otmpMessage = Nothing         If Err.Number <> 0 Then       MsgBox "There was an error in the free/busy checking routine."       Err.Clear    End If End Sub      Function CheckFB(strFB, dFBStart, dStartTime, dEndTime, strUserName)    'This function takes the starttime and the endtime for an appointment    'and checks the free/busy for the user to see if the user    'is free/busy/tenative    'Returns back a string to insert into the label    If Len(strFB) = 0 Then       CheckFB = "Free/Busy information not available"    Else       'Grab Start time and figure out how far into the FB string the app       'needs to go       'Check to see if the appointment starts on the hour or half hour       iMinute = Minute(TimeValue(Cdate(dStartTime)))       If  iMinute <> 0 AND iMinute <> 30 Then          'Figure out which side of the half hour the appt is on          If iMinute < 30 Then             'Move it back to the hour             dStartTime = DateValue(dStartTime) & " " & _                          Hour(dStartTime) & ":00"          ElseIf iMinute > 30 Then             'Move it ahead to the next hour             'See if flips to next day             dStartTime = DateAdd("h",1,dStartTime)             dStartTime = DateValue(dStartTime) & " " & _                          Hour(dStartTime) & ":00"          End If               dStartTime = FormatDateTime(dStartTime, 2) & " " & _                       FormatDateTime(dStartTime, 3)       End If            'Since 1 day = 48 half-hour increments,       'get the diff between start time       'of appt and start time of F/B period       Dim i30minDiffBeginEnd       Dim i30minDiff            i30minDiff = DateDiff("n",dFBStart,dStartTime)       'Divide it by 30       i30minDiff = i30minDiff/30       'See if out of bounds due to flipping to next day       If i30minDiff < Len(strFB) Then          'Jump into the begin. middle or end of string          'Figure out how many half-hour increments we need          'go to get the F/B          i30minDiffBeginEnd = DateDiff("n",dStartTime,dEndTime)          i30minDiffBeginEnd = i30minDiffBeginEnd / 30               'Jump into the string          iFree=0          iTenative = 0          iBusy = 0          iOOF = 0               Dim strText          For z=1 To i30minDiffBeginEnd             tmpFB = mid(strFB,i30minDiff + z,1)                  Select Case tmpFB                Case 0:                   iFree = iFree + 1                Case 1:                   iTenative = iTenative + 1                Case 2:                   iBusy = iBusy + 1                Case 3:                   iOOF = iOOF + 1             End Select          Next               If iFree=i30minDiffBeginEnd Then             'Totally Free             CheckFB = strUserName & " is free from " & _                       formatdatetime(dStartTime,3) & " to " & _                       formatdatetime(dEndTime,3) & "."             Exit Function          End If               'This routine counts the timeslots but we do not need          'to display this.  Left in for your convenience.               If iTenative > 0 Then             'strText = iTenative & " Tenative"             strText = "Tenative"          End If          If iBusy > 0 Then             'If strText <> "" Then             '   strText = strText & ", " & iBusy & " Busy"             'Else             '   strText = iBusy & " Busy"             'End If             strText = "Busy"          End If          If iOOF > 0 tThen             'If strText <> "" Then             '   strText = strText & ", and " & iOOF & " Out-of-Office"             'Else             '   strText = iOOF & " Out-of-Office"             'End If             strText = "Out-of-Office"          End If          If strText = "" Then             'Unknown!             'Say it's free             strText = strUserName & " calendar is showing free from " & _                       formatdatetime(dStartTime,3) & " to " & _                       formatdatetime(dEndTime,3) & "."          End If          CheckFB = strUserName & " calendar is showing " & strText & _                    " " & formatdatetime(dStartTime,3) & _                    " to " & formatdatetime(dEndTime,3) & "."       Else             'Longer than the string, say unknown             CheckFB = "Free/Busy status is unknown."       End If    End If End Function