Programming MicrosoftВ® OutlookВ® and Microsoft Exchange 2003, Third Edition (Pro-Developer)
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