لطفا منتظر باشید ...
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
