Updated Agent Install Application

Now let's take a look at the updated Agent Install application. I added some new functionality that allows you to view and edit maps, copy the maps into other folders, and track process instances in folders. The code in this section uses objects in the Routing Object library and the Event Config library. I had to make a number of enhancements to make the program work with process instances and routing maps.

Overview of the Updated Agent Install Application

The enhancements for the Agent Install application fall into four main areas:

  • Agent enhancements, such as creating and deleting routing agents
  • Routing map enhancements, such as the ability to edit and delete maps
  • Process instance enhancements, such as the ability to view process instances and see which row in the map the process instance is currently executing
  • User interface enhancements, such as being able to see which folders contain agents, routing maps, or nothing

Now we'll examine the code that implements each type of enhancement.

Agent Enhancements

When you start the new version of Agent Install, you'll notice more options to choose from on the main page. These new options, shown in Figure 13-11, include viewing the default map for the folder, deleting a map, and viewing the processes executing in the folder. System enhancements also include the counting of messages contained in the folder, which will help you estimate how long opening all processes will take when you click the View Processes button.

click to view at full size.

Figure 13-11 The updated Agent Install program, which includes routing object functionality.

Detecting Default Routing Maps in a Folder

When you select a folder that does not contain a routing map, the enhancements, with the exception of viewing processes, will be disabled. The functionality to detect a default routing map in the folder is implemented in the RefreshAgentCount subroutine. This subroutine is able to detect not only agents in the folder but also maps, as shown in the following code listing:

 Public Sub RefreshAgentCount() On Error GoTo RefreshAgentCount_Err     GetMessageCount          Dim bRouteMap     Dim bRouteType     Dim intFoundRoutingMap, intFoundRoutingAgent     intFoundRoutingMap = 0     intFoundRoutingAgent = 0     lblMap.Caption = ""     Set oRouteBinding = Nothing     Set oRTMessageMap = Nothing     cmdViewMap.Enabled = False     cmdDeleteMap.Enabled = False     cmdAddAgent.Enabled = True     cmdDeleteAgent.Enabled = True     cmdViewScript.Enabled = True          Set oBoundFolder = oEvents.BoundFolder(oFolder, True)     Set oBindings = oBoundFolder.Bindings     If oBindings.Count = 1 Then         lblAgentCount.Caption = "There is 1 agent in this folder."     Else         lblAgentCount.Caption = "There are " & oBindings.Count & _             " agents in this folder."     End If     comboAgents.Clear     'Clear the binding     If oBindings.Count > 0 Then         For Each oBinding In oBindings             comboAgents.AddItem CStr(oBinding.Name)             'Assume there is one binding in the folder             'for routing             Set oRouteBinding = oBinding         Next     End If             'Check for routing maps as well             On Error Resume Next             If Err.Number = 0 Then                 'Found one                 Set oHidden = oFolder.HiddenMessages                 For Each oHide In oHidden                     Err.Clear                     tmpTest = oHide.Fields("RouteAgent")                     If Err.Number = 0 Then                         intFoundRoutingAgent = 1                     End If                                          Err.Clear                     bRouteMap = oHide.Fields("RouteMap")                     If Err.Number = 0 Then                         cmdViewMap.Enabled = True                         cmdDeleteMap.Enabled = True                         intFoundRoutingMap = 1                         Set oRTMessageMap = oHide                     End If                                          Err.Clear                     bRouteType = oHide.Fields("RouteType")                     If Err.Number = 0 Then                     End If                 Next                 If intFoundRoutingMap Then                     lblMap = "There is a routing map in this " & _                         "folder." & vbLf & "The type of route " & _                         "is a " & bRouteType & " route."                 End If             End If             Err.Clear         comboAgents.ListIndex = 0     Exit Sub RefreshAgentCount_Err:     If Err.Number = -2147221245 Then         MsgBox "Outlook Calendar folders are not supported.", _             vbOKOnly + vbExclamation, _         "Select Folder"         lblAgentCount.Caption = "Not Supported"         lblMap.Caption = ""         comboAgents.Clear         cmdAddAgent.Enabled = False         cmdDeleteAgent.Enabled = False         cmdViewScript.Enabled = False         Exit Sub     End If End Sub 

As you can see in the code, to detect default routing maps in the folder, we first must get the HiddenMessages collection from the CDO Folder object. All default routing maps are stored as hidden messages with a special property, so after we retrieve the HiddenMessages collection, all we need to do is traverse it to look for RouteMap custom property.

In the code, we also look for the RouteType property on any hidden message. Both the Routing Wizard sample application and this application insert a string to tell the user the route type contained in the folder. In the Routing Wizard application, the only possible values are Sequential and Parallel. In this application, when we modify a map created by the Routing Wizard, the RouteType property changes to Custom so that you know it is not the original map.

If a default routing map is found in the folder, some of the other command buttons, such the one for viewing the default map, are enabled. The RefreshAgentCount subroutine also sets some variables that will be used throughout the rest of the application, such oRTMessageMap, which correspond to the hidden message containing the default message map as well as to oRouteBinding, which stores the binding for the folder. Recall from earlier in the chapter that the default map is copied onto all incoming messages that do not correspond to a process instance in the folder, or onto items that do not currently contain a RouteMap property with an ad-hoc routing map.

Adding New Agents That Already Have a Routing Map in the Folder

Now that the code can detect default routing maps in the folder, the program has to be able to detect when a user is adding an agent to the folder when a routing map is in the folder—you do not want users to add multiple agents to a folder if they want to use the folder for routing. Instead, you want in the folder only one agent, which fires on all the events. This agent should also contain the default script for the custom actions for the routing map.

To prevent users from adding an arbitrary number of agents to a folder with a routing map, the cmdAddAgent_Click subroutine had to be updated to detect the routing map. A snippet of this code is shown here:

 'Check for message map If Not (oRTMessageMap Is Nothing) Then     'Check for exisiting agent     If Not (oRouteBinding Is Nothing) Then         MsgBox "An Agent already exists in this folder with a " & _             "Routing Map.  You cannot add another one." _             , vbOKOnly + vbExclamation, "Add Agent"         Exit Sub     Else         result = MsgBox("There is already a Routing Map in " & _             the folder.  This application can" _             & " only create Routing Agents in folders that " & _             have Routing Maps already installed." _             & vbLf & "Do you want to create a Routing Agent?", _             vbYesNo + vbQuestion, "Rounting Map Found")         If result = vbYes Then             MsgBox "You must now select a script to associate " & _                 "with your Routing Map and Agent.  Please use" _                 & " the following dialog box to select a script.", _                 vbOKOnly + vbInformation, "Add Agent"             intCaller = 2             Load frmSelectScript             frmFolders.Visible = False             frmSelectScript.Visible = True             Exit Sub         Else             'They said no             Exit Sub         End If     End If End If 

This code first checks to see whether oRTMessageMap exists. If it does, a default routing map is in the folder. Then the code checks to see whether oRouteBinding exists. If oRouteBinding does exist, a routing agent is in the folder. This code stops the user from adding another agent to the folder.

If only the default message map exists in the folder without an agent, the code prompts the user to select a script, which the system will associate with the new agent it will create by opening the frmSelectScript form. After the user has selected the script to associate with the new routing agent in the folder, the code creates a new agent that uses the default message map in the folder, as shown in this code from the MSRTVars module for the Agent Install program:

 Public Sub CreateRoutingAgent_MapExists(otmpFolder)     Set otmpEvents = oEvents     Set otmpBoundFolder = otmpEvents.BoundFolder(otmpFolder, True)     Set otmpBindings = otmpBoundFolder.Bindings     Set otmpBinding = otmpBindings.Add     otmpBinding.Name = "Routing Agent"     otmpBinding.Active = MSAgentActive     otmpBinding.EventMask = MSScheduledEvent + MSNewItemEvent + _         MSChangedItemEvent + MSDeletedItemEvent     otmpBinding.HandlerClassID = MSRoutingObjectsHandlerID     otmpBinding.SaveChanges          Set otmpSchedule = otmpBinding.Schedule     otmpSchedule.Interval = 60     otmpSchedule.Type = MSHourlyAgent     otmpSchedule.Days = MSMonday + MSTuesday + MSWednesday + _         MSThursday + MSFriday + MSSaturday + MSSunday     otmpSchedule.StartTime = MSAllDayStart     otmpSchedule.EndTime = MSAllDayEnd     otmpBinding.SaveChanges          'Get the new binding message     Set oSaveAsMessage = CDOClass.Session.GetMessage( _         otmpBinding.EntryID, Null)          'Add the RouteAgent property     oSaveAsMessage.Fields.Add "RouteAgent", VT_BOOL, True     bstrEventScript = OpenScriptFile(strFileLocation)     oSaveAsMessage.Fields.item(PR_EVENT_SCRIPT) = bstrEventScript     oSaveAsMessage.subject = "Routing Agent"     oSaveAsMessage.Update     otmpBinding.SaveCustomChanges oSaveAsMessage     otmpBinding.SaveChanges     otmpBoundFolder.SaveChanges     MsgBox "Successfully created new Agent with the existing " & _         "Routing Map in Folder.", vbOKOnly + _         vbInformation, "Create Agent" End Sub 

The only difference between this code and the code for creating event agents, which we looked at earlier, is that this code adds a custom property to the agent, named RouteAgent, which identifies the agent as a routing agent. Other than that, all this code should be familiar to you from the previous chapter.

Deleting an Agent with a Default Routing Map in the Folder

Now that we have taken care of adding a new agent when a default routing map is in the folder, what do we do about deleting an agent when the same condition exists? We could ignore the routing map in the folder and just delete the agent. But to give the user more control, after deleting the agent, we should prompt the user about whether the user also wants to delete the default routing map in the folder.

Implementing this functionality is really quite easy. Because we have the variable oRTMessageMap, which is a CDO Message object containing the default map, all we need to do is call the Delete method on oRTMessageMap to delete the map, as shown here:

 Private Sub cmdDeleteAgent_Click() On Error GoTo cmdDeleteAgentClick_Err If comboAgents.Text <> "" Then     'Agent is selected     response = MsgBox("Are you sure you want to delete the " & _         comboAgents.Text & " agent?", vbQuestion + vbOKCancel, _         "Delete Agent")     If response = vbOK Then         'Delete agent         For Each oBinding In oBindings             If comboAgents.Text = CStr(oBinding.Name) Then                 Exit For             End If         Next         oBindings.Delete oBinding         oBoundFolder.SaveChanges         MsgBox "Agent Successfully Deleted.", vbInformation + _             vbOKOnly, "Delete Agent"         'Check for map as well         If Not (oRTMessageMap Is Nothing) Then             result = MsgBox("There is a Routing Map in this " & _                 folder.  Do you want to delete it as well?", _                 vbYesNo + vbQuestion, "Routing Map Found")             If result = vbYes Then                 oRTMessageMap.Delete             End If         End If         RefreshAgentCount     Else         MsgBox "The Agent will not be deleted.", vbInformation + _             vbOKOnly, "Cancel Deletion"     End If   Else     MsgBox "You must first select an agent.", vbExclamation + _         vbOKOnly, "No agent selected." End If Exit Sub cmdDeleteAgentClick_Err:     If Err.Number = &H46 Then         MsgBox "You do not have permission to delete agents in " & _             "this folder. Please choose another folder.", vbOKOnly + _             vbCritical, App.Title     Else         Call CDOClass.MapiErrorHandler("cmdAddAgent execution " & _             "in frmFolders while trying to access folder " & _             "information.")     End If Exit Sub End Sub 

Routing Map Enhancements

The enhancements to this application include new code that implements routing map editing functionality. This functionality includes the ability to view routing maps, edit them, parse their script for routing functions, and save them to other folders.

The user interface for viewing and editing the routing maps is a grid control in Visual Basic. This grid control, shown in Figure 13-12, makes it easy for you to scroll through and look at your maps as well as add or delete rows and columns to maps.

click to view at full size.

Figure 13-12 The grid control in the updated Agent Install program to view and edit routing maps.

I do not want to dive into the ins and outs of using the grid control, but I will tell you that it is very useful. You should consider learning more about it either by examining the code for this program or by reading the online help.

Viewing a Map

When you click on the view default map command from the main screen of the application, you open the default map form called frmRouting. This form contains a lot of code to implement the map viewing, editing, and save features in the application. The first feature we'll look at is the map viewing functionality.

As we saw with the Routing Object library, we can retrieve the activity count and individual rows as well as other information about a routing map in a folder. The viewing capabilities of the Agent Install application are implemented through these routing objects. This is the code for the Form_Load function:

 Private Sub Form_Load() Dim arrArgs As Variant     MAXCOLUMNS = 5     COLCONSTANT = 5     IsDirty = 0     cTab = Chr(9)     'Clear the grid     flexMap.Clear     'Add the headers to the Grid     FormatColumnHeaders     'Fill Intrinsic Action array     FillIntrinsicActionsArray     'Populate the commands combo.     'This should also pull from script.     PopulateCombo     'Set bValidScript to indicate no script     bValidScript = 0     If oRouteBinding Is Nothing Then         lblScriptLocation.Caption = "None"     End If     bstrEventScript = ""     'Fill in Folder Name     lblCurrentFolder.Caption = oFolder.Name          'Load the Map and the Activities into the grid     Set oRTMap = CreateObject("exrt.map")     If intMapViewer = 0 Then         oRTMap.Message = oRTMessageMap     ElseIf intMapViewer = 1 Then         oRTMap.Message = oRTMessageMap     End If     oRTMap.OpenMap TBL_OPEN_READWRITE     lActivityCount = oRTMap.ActivityCount     For i = 1 To oRTMap.ActivityCount         Set oRTRow = CreateObject("exrt.row")         oRTMap.GetRow i - 1, oRTRow         flexMap.AddItem ""         flexMap.TextMatrix(i, 1) = CStr(oRTRow.ActivityID)         flexMap.TextMatrix(i, 2) = oRTRow.Action         flexMap.TextMatrix(i, 3) = CStr(oRTRow.Flags)         'Figure out how many parameters there are         arrArgs = Array()         oRTRow.GetArgs 1, arrArgs         If (UBound(arrArgs) + COLCONSTANT) > MAXCOLUMNS Then             flexMap.Cols = UBound(arrArgs) + COLCONSTANT             MAXCOLUMNS = UBound(arrArgs) + COLCONSTANT             FormatColumnHeaders         End If         For tmpCounter = 0 To UBound(arrArgs)             tmpArg = arrArgs(tmpCounter)             flexMap.TextMatrix(i, tmpCounter + (COLCONSTANT - 1)) = _                 CStr(tmpArg)         Next     Next     If intMapViewer = 1 Then         'Point to the current row         tmpCurrentRow = oRTProcInstance.CurrentRow         flexMap.Col = 0         'If it can't figure out the current row,         'skip to the next one         On Error Resume Next         flexMap.Row = tmpCurrentRow         Set flexMap.CellPicture = LoadPicture("Arw05rt.ico")         flexMap.CellPictureAlignment = flexAlignRightCenter         flexMap.Col = 1         flexMap.Row = tmpCurrentRow                  'Disable SaveAs         cmdSaveAs.Enabled = False                      'Check to see if there is a RouteBinding object.         'If there is, enable Open Script.         If Not (oRouteBinding Is Nothing) Then             cmdOpenScript.Enabled = True         Else             cmdOpenScript.Enabled = False         End If     End If End Sub 

First the code clears the grid so that no previous map information is shown. Then the code calls the FormatColumnHeaders function, which places the names of the columns such as ActivityID at the top of the grid. FillIntrinsicActionsArray is called next, and then PopulateCombo is called. These two functions are not critical—all they do is fill in an array with the name of the intrinsic map actions and then populate a combo box with those actions. However, they do provide convenient features for users of the application, who can quickly select the different actions for the map by using the newly populated combo box.

The interesting part of the code occurs after the FillIntrinsicActionsArray and PopulateCombo functions are called. Some variables are set so that the application knows the user hasn't yet selected a valid script. Then, after more initialization, the grid is filled in with the rows from the map. This is accomplished by creating a Map object and setting its Message property to the correct CDO Message object. Why is there is an intMapViewer variable? This variable tells the frmRouting form which map to view: the default map in the folder, or a specific map on a particular message. You will see how this is implemented in the Process Instance enhancements section.

After setting the Message property, we need to open the map by using the OpenMap method and specifying that we want to open the map as read/write. Then we use the ActivityCount property to find out how many activities are in the map. A For...Loop is created using the ActivityCount property as the control variable. This loop creates a new Row object. The GetRow method is called on the Map object; the row number is passed in as well as the new Row object in which the row will be placed. Specific information is pulled from the returned Row object using the ActivityID, Action, and Flags properties for the Row object.

To retrieve the parameters for the rows, the program creates a new array variable. Then it gets the parameters by passing the array variable to the GetArgs method on the Row object. Now that the program has the rows, it needs to see whether the number of parameters returned is greater than the number of columns in the grid control. If it is, the code adds the required number of new columns and reformats the column headers.

Let's skip the If statement, which checks to see whether intMapViewer = 1, for right now. We will look at this later in the chapter, because this section of the code implements custom functionality for process instances rather than the default routing map in the folder.

Editing the Map

The code for editing the map, which involves adding or deleting rows and columns and changing the text in a specific cell, does not have much routing object functionality because it's mostly automation of the grid control. For this reason, this functionality will not be covered. However, you can look at the source code for the application on the companion CD to see how it is implemented.

Selecting and Parsing Scripts

To allow users of the application to change the script they want to use with the routing map, the application allows selection of a script from the file system. It also allows the user to decide whether to save the script in the agent as the default script for the folder. This option is only available when an agent is actually in the folder, not just a routing map in the folder without an agent. The application will also allow you to parse the script for route functions.

To select a script, the user clicks the Select Script button on the map viewer. The application detects whether an agent is already in the folder and asks the user whether she wants to use the default script already in the folder. If the user chooses not to, the application launches a separate form that allows the user to select a script from the file system, as shown in Figure 13-13. Once the user selects the script, the application tries to read the script and prompts the user about whether she wants to save the script in the agent binding or try to parse the script for functions.

Figure 13-13 The Select Script dialog box allows users to find and select scripts from the file system.

The code that implements the Select Script button is shown here:

 Private Sub cmdOpenScript_Click()     If intMapViewer = 1 Then         MsgBox "You can load only the default script for the " & _             "folder.  This script will be loaded.  You can " & _             "then parse the script for functions.", vbOKOnly _             + vbInformation, "Select Script"         strFileLocation = "Message"         checkParseScript.Value = vbUnchecked         checkParseScript.Enabled = True         checkSaveScript.Value = vbUnchecked         checkSaveScript.Enabled = False         lblScriptLocation.Caption = "Default script in Folder"         Exit Sub     End If     If Not (oRouteBinding Is Nothing) Then         'There is actually an Agent in the folder         result = MsgBox("Do you want to use the default script " & _             "in the folder?", vbYesNo + vbInformation, _             "Use Default Script")         If result = vbYes Then             strFileLocation = "Message"             'Enable only Parse Script and remove old script actions             checkParseScript.Value = vbUnchecked             checkParseScript.Enabled = True             checkSaveScript.Value = vbUnchecked             checkSaveScript.Enabled = False             lblScriptLocation.Caption = "Default script in Folder"             Exit Sub         End If     End If     frmRouting.Visible = False     intCaller = 1     frmSelectScript.Visible = True End Sub 

When the user clicks the OK button in the Select Script dialog box, frmSelectScript, the following code is called:

 Private Sub cmdOK_Click()     'Check for script selected     If fileCurFile.FileName = "" Then             MsgBox "You must first select a script for the agent.", _                 vbExclamation + vbOKOnly, "No Script Selected"            Exit Sub     End If     tmpFileLocation = fileCurFile.Path & "\" & fileCurFile.FileName     'Try to open the script     bstrScriptTest = OpenScriptFile(tmpFileLocation)     If bstrScriptTest <> "" Then         strFileLocation = tmpFileLocation         If intCaller = 1 Then         'Remove old script functions         frmRouting.checkParseScript.Value = vbUnchecked                      'Only for frmRouting             If Not (oRouteBinding Is Nothing) Then                 result = MsgBox("When saving your map, would " & _                     "you like to save this script with it?", _                     vbYesNo, "Save Script with Map")                 If result = vbYes Then                     frmRouting.checkSaveScript.Value = vbChecked                 Else                     frmRouting.checkSaveScript.Value = vbUnchecked                 End If             Else                 frmRouting.checkSaveScript.Value = vbUnchecked             End If             result = MsgBox("Would you like the program to try " & _                 "and parse the script for functions?", _                 vbYesNo, "Parse Script")             If result = vbYes Then                 frmRouting.checkParseScript.Value = vbChecked             End If             'Mark that we have a valid script             bValidScript = 1             frmRouting.checkParseScript.Enabled = True             If Not (oRouteBinding Is Nothing) Then                 frmRouting.checkSaveScript.Enabled = True             Else                 frmRouting.checkSaveScript.Enabled = False             End If             'Replace the \\ in the location             strFileLocation = Replace(strFileLocation, "\\", "\", _                 1, 1)             'Display it in the form             frmRouting.lblScriptLocation = strFileLocation             If Not (oRouteBinding Is Nothing) Then                 frmRouting.MakeDirty             End If         End If         If intCaller = 2 Then             CreateRoutingAgent_MapExists oFolder             frmFolders.RefreshAgentCount         End If         Unload Me     End If End Sub 

One of the neat aspects of the application is that it parses the script for route functions because it can easily find route functions. How? Recall that all route functions must begin with the word Route_ before the function name. All the code has to do is search for the script file for Sub Route_, and then grab the characters appearing between the location for Sub Route_ and a Return or an open parenthesis, which would indicate that an argument list is coming next. The application then populates the same combo box populated by the intrinsic script actions so that you can easily select either an intrinsic action or a custom action from the script without having to look at reference materials or the script itself. The code for this is shown here:

 Sub ParseScriptforFunctions(tmpFileLocation)     'Return value is array of Sub and Function names found in      'the script.     'If none are found, returns empty.     Dim arrSubNames(100)     arrSubNames(0) = ""     arrCounter = 0     If tmpFileLocation = "Message" Then         Set oMessage = oSession.GetMessage( _             oRouteBinding.EntryID, Null)         bstrEventScript = oMessage.Fields.item(PR_EVENT_SCRIPT)     Else         bstrEventScript = OpenScriptFile(tmpFileLocation)     End If     found = 1     Do While (found <> 0 Or found <> Null)         found = InStr(found, bstrEventScript, "Sub Route_")         If found <> 0 Then            'Got one, now look for the name after the _.            'First look for a ( after found.            tmpUnderScore = 0            tmpUnderScore = InStr(found, bstrEventScript, "_")            If tmpUnderScore <> 0 Then 'Is should never be 0                 'Now start picking off characters until you                 'hit a parens or a new line.                 'Move to next character.                 tmpCurLocation = tmpUnderScore + 1                 tmpChar = Mid(bstrEventScript, tmpCurLocation, 1)                 tmpSubName = ""                 Do While tmpChar <> "(" And tmpChar <> Chr(13)                     tmpSubName = tmpSubName & tmpChar                     tmpCurLocation = tmpCurLocation + 1                     tmpChar = Mid(bstrEventScript, tmpCurLocation, 1)                 Loop                 arrSubNames(arrCounter) = tmpSubName                 arrCounter = arrCounter + 1             End If         found = found + 1         End If     Loop     PopulateComboCustomActions arrSubNames, arrCounter     If arrSubNames(0) <> "" Then         MsgBox "Successfully added " & arrCounter & _             " functions from the script.", _             vbOKOnly + vbInformation, "Parse Script"     Else         MsgBox "No Route functions were found when parsing " & _             "the script.", vbOKOnly + vbInformation, "Parse Script"     End If End Sub Sub PopulateComboCustomActions(arrActions, arrCounter)     For i = 0 To arrCounter - 1         frmRouting.comboCommands.AddItem arrActions(i)     Next End Sub Function OpenScriptFile(tmpFileLocation) As Variant On Error GoTo OpenScriptFile_Err     Open tmpFileLocation For Input As #1         bstrEventScript = Input$(LOF(1), #1)     Close #1     OpenScriptFile = bstrEventScript     Exit Function OpenScriptFile_Err:     MsgBox "There was an error opening the script file. " & _         "Please select a different file." & vbLf & _         Err.Description, vbOKOnly + vbExclamation, _         "Open Script"     bValidScript = 0     Close #1     OpenScriptFile = "" End Function 

An example of this functionality is shown in Figure 13-14.

If you uncheck the Parse Script For Functions check box, the code will automatically remove the custom actions from the combo box and leave only the intrinsic actions.

The application also makes it easier for you to create new maps after deleting all the rows in a old map because it automatically calculates the ActivityIDs for your rows starting at 100 and incrementing by 10. You should be careful when using this functionality, because the code cannot detect whether a Goto has jumped to the correct place after you run the calculation.

Figure 13-14 The combo box populated with the intrinsic as well as custom script actions for a routing map.

The application can automatically detect when you type in a custom action or intrinsic action in the Action column, and it will set the Flags property correctly for you (to 0 for an intrinsic action and 2 for a custom action). You must parse the script for functions to make the custom action detection code work. This action detection functionality, illustrated in the following code, is implemented using the string functions provided in Visual Basic. The code shows you how to perform an exact match of names by using the InStr function and flipping the arguments.

 Private Sub ApplyIntrinsic(tmpNum)     'This subroutine applies the flags and any custom settings     'for intrinsic objects     flexMap = arrIntrinsic(tmpNum)     SetFlag RT_Flag_Intrinsic End Sub Private Sub ApplyScriptAction(tmpNum)     'This subroutine applies the flags and any custom settings     'for intrinsic objects     flexMap = comboCommands.List(tmpNum)     SetFlag RT_Flag_VBFunction End Sub Private Sub SetFlag(intFlag)     tmpNextCol = flexMap.Col + 1    'Should be flags     tmpCurRow = flexMap.Row     flexMap.TextMatrix(tmpCurRow, tmpNextCol) = intFlag End Sub Private Sub CheckforIntrinsic()     'Checks to see if user typed Intrinsic Action     tmpString = comboCommands.Text     If tmpString <> "" Then         tmpString = UCase(tmpString)         For i = 0 To (intNumIntrinsicActions - 1)             result = InStr(1, UCase(arrIntrinsic(i)), tmpString)             If result = 1 Then                 resultotherway = InStr(1, tmpString, _                     UCase(comboCommands.List(i)))                 If resultotherway = 1 Then                     ApplyIntrinsic (i)                     'Set the flags automatically for the user                     Exit Sub                 End If             End If         Next         'No intrinsic         SetFlag RT_Flag_VBFunction     End If End Sub Private Sub CheckforScriptAction()     'Checks to see if user typed Intrinsic Action     tmpString = comboCommands.Text     If tmpString <> "" Then         tmpString = UCase(tmpString)         If intNumIntrinsicActions = comboCommands.ListCount Then             'No script actions             Exit Sub         Else             For i = intNumIntrinsicActions To _             (comboCommands.ListCount - 1)                 'Check the strings both ways to get an exact match                 result = InStr(1, UCase(comboCommands.List(i)), _                     tmpString)                 If result = 1 Then                     resultotherway = InStr(1, tmpString, _                         UCase(comboCommands.List(i)))                     If resultotherway = 1 Then                         ApplyScriptAction (i)                         Exit Sub                     End If                 End If             Next         End If     End If End Sub 

Saving the Routing Map

The application automatically detects when the user makes changes to a cell in the map and enables the Save button. To save your map in the folder, click the Save button. If you have the check box named When Saving, Save Script In Agent Binding enabled, the application will also save the selected script as the new script for the agent. Here is the code that handles this functionality:

 Private Sub PrintoutMapError(strError)     MsgBox strError, vbOKOnly, "Map Error" End Sub Private Function CheckforValidMap() As Boolean     'This subroutine checks to make sure the map is somewhat      'valid before saving.     'It checks to make sure columns with activities have IDS.     'It also checks to make sure the first 3 columns - ID,      'Flags and Action - are still available by checking the      'column headers.     'You should never be able to delete these columns anyway.     If flexMap.TextMatrix(0, 1) <> "ActivityID" Then         PrintoutMapError "You do not have an ActivityID column " & _             "in the right place!"         CheckforValidMap = False         Exit Function     End If     If flexMap.TextMatrix(0, 2) <> "Action" Then         PrintoutMapError "You do not have an Action column in " & _             "the right place!"         CheckforValidMap = False         Exit Function     End If     If flexMap.TextMatrix(0, 3) <> "Flags" Then         PrintoutMapError "You do not have a Flags column in the " & _             "right place!"         CheckforValidMap = False         Exit Function     End If          tmpNumRows = flexMap.Rows - flexMap.FixedRows     tmpNumCols = flexMap.Cols - flexMap.FixedCols     For ltmpRow = 1 To tmpNumRows         tmpDataExists = 0         For ltmpCol = flexMap.FixedCols To tmpNumCols             If flexMap.TextMatrix(ltmpRow, ltmpCol) <> "" Then                 'tmpDataExists contains the first Col with Data                 tmpDataExists = ltmpCol                 Exit For             End If         Next         If tmpDataExists Then             'Check for ActivityID             If flexMap.TextMatrix(ltmpRow, 1) = "" Then                 PrintoutMapError "No Activity IDs for Row #:" & _                     ltmpRow & vbLf & "The first set of data in " & _                     "this row is " & flexMap.TextMatrix( _                     ltmpRow, tmpDataExists) _                     & vbLf & "The map will not be saved."                     CheckforValidMap = False                 Exit Function             End If             If flexMap.TextMatrix(ltmpRow, 2) = "" Then                 PrintoutMapError "No Activity set for Row #:" & _                     ltmpRow & vbLf & "The first set of data in " & _                     "this row is " & flexMap.TextMatrix( _                     ltmpRow, tmpDataExists) _                     & vbLf & "The map will not be saved."                     CheckforValidMap = False                 Exit Function             End If             If flexMap.TextMatrix(ltmpRow, 3) = "" Then                 PrintoutMapError "No Flag is set for Row #:" & _                     ltmpRow & vbLf & "The first set of data " & _                     "in this row is " & flexMap.TextMatrix( _                     ltmpRow, tmpDataExists) _                     & vbLf & "The map will not be saved."                     CheckforValidMap = False                 Exit Function             End If         End If     Next     CheckforValidMap = True End Function Public Sub SaveCurrentMap(otmpMessage)     Dim oRTRow As Variant     Dim oRTTmpMap As Object     Dim lParamCount As Long     Set RTTmpMap = Nothing     Dim tmpArr As Variant     'Array to hold current row parameters     Dim arrParameters As Variant     tmpRowCount = flexMap.Rows - flexMap.FixedRows     tmpParamColumns = MAXCOLUMNS - COLCONSTANT     Set oRTTmpMap = CreateObject("exrt.map")     'Clear the map     oRTTmpMap.DeleteMap     If otmpMessage = -1 Then         oRTTmpMap.Message = oRTMessageMap     Else         oRTTmpMap.Message = otmpMessage     End If     oRTTmpMap.SaveMap     oRTTmpMap.OpenMap TBL_OPEN_READWRITE     'Scroll through all the rows in the table and     'write them out     For tmpRow = 1 To tmpRowCount         'Create the Row object         Set oRTRow = Nothing         Set oRTRow = CreateObject("exrt.row")         'Get columns with data in current row, skip blanks         intFoundSomething = 0         ReDim arrParameters(tmpParamColumns)         ReDim tmpArr(0)         For tmpCol = flexMap.FixedCols To (flexMap.Cols - 1)             If flexMap.TextMatrix(tmpRow, tmpCol) <> "" Then                 intFoundSomething = 1                 Exit For             End If         Next         If intFoundSomething Then             lParamCount = 0             tmpArrayCount = 0             For tmpCol = (COLCONSTANT - 1) To (MAXCOLUMNS - 1)                 tmpdata = flexMap.TextMatrix(tmpRow, tmpCol)                 If tmpdata <> "" Then                     'Data in the column                     arrParameters(tmpArrayCount) = tmpdata                     'Increase the parameter/argument count                     lParamCount = lParamCount + 1                     tmpArrayCount = tmpArrayCount + 1                 End If             Next 'Column             If lParamCount <> 0 Then                 ReDim tmpArr(lParamCount - 1)                 For i = 0 To (lParamCount - 1)                     If IsNumeric(arrParameters(i)) Then                         tmpArr(i) = CLng(arrParameters(i))                     Else                         tmpArr(i) = CStr(arrParameters(i))                     End If                 Next             End If             oRTRow.SetArgs lParamCount, tmpArr             oRTRow.ActivityID = CLng(flexMap.TextMatrix(tmpRow, 1))             oRTRow.Action = CStr(flexMap.TextMatrix(tmpRow, 2))             oRTRow.Flags = CLng(flexMap.TextMatrix(tmpRow, 3))             oRTTmpMap.InsertActivity -1, oRTRow         Else             'Didn't find anything             Set oRTRow = Nothing         End If     Next 'Row         'Need to change something on the message     If otmpMessage = -1 Then         oRTMessageMap.Fields.Add "RouteType", vbString, "Custom"         oRTTmpMap.SaveMap         oRTMessageMap.Update     Else         On Error Resume Next         Dim strRouteType As String         strRouteType = oRTMessageMap.Fields.item("RouteType")         If strRouteType = "" Then             strRouteType = "Custom"         End If         otmpMessage.Fields.Add "RouteType", vbString, strRouteType         oRTTmpMap.SaveMap         otmpMessage.Update     End If End Sub Private Sub RemoveDirtyFlag()     'Reset dirty bit and disable save until next change     IsDirty = 0     cmdSaveChanges.Enabled = False End Sub Private Sub cmdSaveChanges_Click()     If CheckforValidMap() Then         If intMapViewer = 1 Then             SaveCurrentMap oRTMessageMap         Else             SaveCurrentMap -1   'Don't need to pass a message         End If         If checkSaveScript.Value = vbChecked Then             SaveRoutingAgentScript             lblScriptLocation.Caption = "Default script in Folder"         End If         RemoveDirtyFlag     End If End Sub Private Sub SaveRoutingAgentScript()     Set otmpMessage = oSession.GetMessage( _         oRouteBinding.EntryID, Null)     bstrEventScript = OpenScriptFile(strFileLocation)     otmpMessage.Fields.item(PR_EVENT_SCRIPT) = bstrEventScript     otmpMessage.Update     oRouteBinding.SaveCustomChanges otmpMessage     oRouteBinding.SaveChanges     oBoundFolder.SaveChanges End Sub 

The first subroutine called is cmdSaveChanges_Click. It calls the CheckforValidMap function, which tries to ensure the user is not entering invalid information into the map. (Note that the CheckforValidMap function does not check every possible error the user could make when creating maps.) After checking for errors, the code checks the intMapViewer value. This value is 0 if the map being viewed is the default folder map, and it is 1 if the map is for a particular process instance.

The next subroutine called is SaveCurrentMap, which has a parameter of _1. A _1 value indicates that SaveCurrentMap should use oRTMessageMap as the CDO Message object as the location in which to save the current routing map. This subroutine then performs the opposite function of the Form_Load subroutine; rather than reading in the information from a map, it writes it out.

You should be aware of a few key issues for the SaveCurrentMap code. First, notice that the SaveCurrentMap subroutine creates an array to keep track of the number of filled-in parameters for each row. If there are seven total columns for parameters in the map and a particular row has only two parameters, the array created is only two items long. If you created an array that is seven items long with five empty items, you would probably get an error when trying to insert your row into a map.

Second, the type conversion of all the variables in the array is to either Long or string. It is a good idea to do this so you do not get errors when executing your maps after saving them.

The third issue to keep in mind involves the last part of the SaveCurrentMap code. The application either adds the field RouteType if it does not already exist on the message or it updates the field if it does exist to indicate the type of route this routing map implements.

If the check box When Saving, Save Script In Agent Binding is enabled and checked, the final subroutine SaveRoutingAgentScript is called in cmdSaveChanges_Click. This subroutine gets the agent message, opens the script file and reads it into a variable, replaces the script on the agent message, and saves the changes.

Process Instance Enhancements

One of the most powerful aspects of the updated Agent Install program is that it gives you the ability to see which messages are process instances in a folder, which users have responded to messages, what the users' responses are, and where in the routing map the process instance is currently executing.

The user interface for the process instance enhancements are shown in Figure 13-15. You can see all the messages in a particular folder and whether or not each message is a process instance. From this interface, you can also view the routing map on the selected process instance as well as view the recipient table for the process instance.

click to view at full size.

Figure 13-15 The View Process Instances form, which allows you to quickly see all the process instances in a folder.

Detecting Process Instances

To implement the process instance enhancements, the application must be able to detect in a particular folder which messages are process instances and which are not. To do this, the application, or more specifically, the frmViewProcInstances form, creates a ProcInstance object, and sets the current message it is looking at in the folder as the object for the Message property on the ProcInstance object. Then the application tries to open the map on the message by using the Map property on the ProcInstance object. If the application fails to open the map, the item is marked as not being a process instance, as the following code illustrates:

 Private Sub Form_Load() 'Update the status     Set tmpoRTMessageMap = oRTMessageMap     frmProgress.pbMessages.Min = 0     frmProgress.pbMessages.Max = intMsgCount     frmProgress.Visible = True     frmProgress.Refresh     lblCurrentFolder.Caption = oFolder.Name     Dim arrTest()     ReDim arrTest(intMsgCount - 1, 4)          On Error Resume Next     For i = 1 To intMsgCount         frmProgress.pbMessages.Value = i         arrTest(i - 1, 1) = oMessages.item(i).Sender.Name         arrTest(i - 1, 2) = oMessages.item(i).subject         arrTest(i - 1, 3) = oMessages.item(i).TimeReceived         arrTest(i - 1, 4) = oMessages.item(i).ID         'Check for maps on the message         Set oProcInstance = Nothing         Set oProcInstance = CreateObject("exrt.ProcInstance")         oProcInstance.Message = oMessages.item(i)         oProcInstance.Open         'An error will be raised. Just ignore it.         Err.Clear         Set tmpoMap = oProcInstance.Map         tmpoMap.OpenMap TBL_OPEN_READONLY         If Err.Number = 0 Then             'Found another one             arrTest(i - 1, 0) = "Yes"         Else             arrTest(i - 1, 0) = "No"         End If     Next     lbMessages.List() = arrTest     Unload frmProgress     frmViewProcInstances.Refresh     lbMessages.ListIndex = 0 End Sub 

Viewing the Recipient Table for a Process Instance

After figuring out which items are process instances and which are not, the application allows the user to view the responses on the Recipient Table tab of View Process Instances dialog box. Figure 13-16 shows the Recipient Table tab for a sample created with the Routing Wizard in a folder named Routed Documents. This tab shows the responses received from the people in the route.

NOTE
The users and their responses in your application are shown by the Agent Install program only if your application uses the RecipientEntry object to track user responses. Because the Expense Routing application does not use the RecipientEntry object to track responses, the Recipient Table tab will display "Unknown" for the status when viewing the Expense Routing folder. However, because applications generated by the Routing Wizard use the RecipientEntry object, you can view users and their responses on the Recipient Table tab for applications generated by the Routing Wizard.

click to view at full size.

Figure 13-16 The Recipient Table tab on the View Process Instances dialog box shows responses received for a sample created with Routing Wizard. Since the Expense Routing application does not use the RecipientEntry object,the Recipient Table tab will not display recipient information.

To retrieve the response information, the application uses the VoteTable and RecipientEntry objects. The application scrolls through the number of recipient entries contained in the message and sets a variable to a RecipientEntry object by using the Item method of the VoteTable object. Once the RecipientEntry object is set, the application pulls off the properties for that recipient, such as the recipient name, the status, and time that status was updated.

 Private Sub ssTabProcInstance_Click(PreviousTab As Integer)     If SSTabProcInstance.Tab = 1 Then         'Clicked on Recipient Table         'Check to see if user selected a message         If lbMessages.ListIndex = -1 Then             'No selected message             MsgBox "Please select a message before clicking on " & _                 "the Recipient & "Table tab.", vbOKOnly + _                 vbExclamation, "Recipient Table"             SSTabProcInstance.Tab = 0             Exit Sub         Else             Dim arrRecips()             Set oRTVote = CreateObject("exrt.VoteTable")             'Get the message             tmpID = lbMessages.Column(4, lbMessages.ListIndex)             Set otmpMessage = oSession.GetMessage(tmpID, Null)             oRTVote.PIMessage = otmpMessage                          If oRTVote.Count = 0 Then                 MsgBox "There is no Recipient Table for this " & _                     "message.", vbOKOnly + vbInformation, _                     "Recipient Table"             Else                 ReDim arrRecips(oRTVote.Count, 2)                 For i = 1 To oRTVote.Count                     Set oRTRecipient = oRTVote.item(i)                     arrRecips(i - 1, 0) = oRTRecipient.Recipient                     If oRTRecipient.Status = "" Then                         arrRecips(i - 1, 1) = "Unknown"                     Else                         arrRecips(i - 1, 1) = oRTRecipient.Status                     End If                     If oRTRecipient.Date = "" Then                         arrRecips(i - 1, 2) = "Unknown"                     Else                         arrRecips(i - 1, 2) = oRTRecipient.Date                     End If                 Next                 lbRecips.List() = arrRecips             End If         End If     End If End Sub 

Viewing the Currently Executing Row in Process Instance

When working with Exchange Server Routing, one of the problems you might run into is not knowing which row a particular process instance is executing. To help you debug your application, you might want to know which row the engine is currently at and see the surrounding rows. The Agent Install application allows you to view the map for a process instance, and it places an arrow next to the currently executing row in the map of the process instance so that you know exactly which row the engine is executing. This arrow is shown in Figure 13-17. When you view the map of a process instance, you will find that almost every time, the current row is either a Terminate or a Wait action.

Figure 13-17 Viewing the routing map for a particular process instance. The arrow points to current state of the process instance.

To indicate which row is executing, the application changes the intMapViewer variable to 1 so that the frmRouting form knows that the form calling it is a process instance map rather than the default map in a folder. The frmRouting form points to the currently executing row and disables some functionality that should not be used on process instance maps. The following code, first taken from frmViewProcInstances and then from frmRouting, creates a process instance object and sets the Message property to be the currently selected message in the listbox on the frmViewProcInstances form. Then the code figures out the currently executing row by using the CurrentRow property on the ProcInstance object, and it loads an arrow graphic to point to that row.

 Private Sub cmdViewMap_Click()     'This is from frmViewProcInstances     intMapViewer = 1     tmpID = lbMessages.Column(4, lbMessages.ListIndex)     Set oRTMessageMap = oSession.GetMessage(tmpID, Null)     Set oRTProcInstance = Nothing     Set oRTProcInstance = CreateObject("exrt.ProcInstance")     Set otmpMessage = oSession.GetMessage(tmpID, Null)     oRTProcInstance.Message = otmpMessage     oRTProcInstance.Open     Load frmRouting     frmViewProcInstances.Visible = False     frmRouting.Visible = True End Sub Private Sub Form_Load() 'This is from frmRouting Dim arrArgs As Variant     MAXCOLUMNS = 5     COLCONSTANT = 5     IsDirty = 0     cTab = Chr(9)     'Clear the grid     flexMap.Clear     'Add the headers to the grid     FormatColumnHeaders     'Fill Intrinsic Action array     FillIntrinsicActionsArray     'Populate the commands combo     'This should also pull from script     PopulateCombo     'Set bValidScript to indicate no script     bValidScript = 0     If oRouteBinding Is Nothing Then         lblScriptLocation.Caption = "None"     End If     bstrEventScript = ""     'Fill in Folder Name     lblCurrentFolder.Caption = oFolder.Name          'Load the map and the activities into the ListBox     Set oRTMap = CreateObject("exrt.map")     If intMapViewer = 0 Then         oRTMap.Message = oRTMessageMap     ElseIf intMapViewer = 1 Then         oRTMap.Message = oRTMessageMap     End If     oRTMap.OpenMap TBL_OPEN_READWRITE     lActivityCount = oRTMap.ActivityCount          For i = 1 To oRTMap.ActivityCount         Set oRTRow = CreateObject("exrt.row")         oRTMap.GetRow i - 1, oRTRow         flexMap.AddItem ""         flexMap.TextMatrix(i, 1) = CStr(oRTRow.ActivityID)         flexMap.TextMatrix(i, 2) = oRTRow.Action         flexMap.TextMatrix(i, 3) = CStr(oRTRow.Flags)         'Figure out how many parameters there are         arrArgs = Array()         oRTRow.GetArgs 1, arrArgs         If (UBound(arrArgs) + COLCONSTANT) > MAXCOLUMNS Then             flexMap.Cols = UBound(arrArgs) + COLCONSTANT             MAXCOLUMNS = UBound(arrArgs) + COLCONSTANT             FormatColumnHeaders         End If         For tmpCounter = 0 To UBound(arrArgs)             tmpArg = arrArgs(tmpCounter)             flexMap.TextMatrix(i, tmpCounter + (COLCONSTANT - 1)) = _                 CStr(tmpArg)         Next     Next     If intMapViewer = 1 Then         'Point to the current row         tmpCurrentRow = oRTProcInstance.CurrentRow         flexMap.Col = 0         'If it can't figure out the current row,         'skip to the next one         On Error Resume Next         flexMap.Row = tmpCurrentRow         Set flexMap.CellPicture = LoadPicture("Arw05rt.ico")         flexMap.CellPictureAlignment = flexAlignRightCenter         flexMap.Col = 1         flexMap.Row = tmpCurrentRow                  'Disable SaveAs         cmdSaveAs.Enabled = False                      'Check to see if there is a RouteBinding object.         'If there is, enable Open Script.         If Not (oRouteBinding Is Nothing) Then             cmdOpenScript.Enabled = True         Else             cmdOpenScript.Enabled = False         End If     End If      End Sub 

User Interface Enhancements

The final set of enhancements we'll discuss is the user interface enhancements to the Agent Install application. You might be asking yourself, "Who cares about user interface enhancements?" You should! These enhancements show you how to detect agents and routing maps in folders as well as how to copy maps and agents to other folders. The main enhancement is in the frmSaveTo form, which is similar to the folder list main screen of the application except that the images representing folders with only routing maps and folders with agents installed differ, as shown in Figure 13-18. This form can be accessed from the main interface of the updated Agent Install application by clicking the View Default Map button and then the Save As button.

click to view at full size.

Figure 13-18 The folder list for the frmSaveTo form. Notice the different icons indicating which folders have agents and which folders have only routing maps.

The user interface enhancements are implemented only in the Save Routing Agent To Folder form, because they have performance implications in that every folder must be checked for a routing agent and a routing map—imagine the amount of time it would take to check each folder if you had hundreds of folders. This code shows how these enhancements are implemented:

 Private Sub SetFolderImage(tmpAgent)     Select Case tmpAgent         Case 0  'Nothing             tmpImgClosed = FOLDER_CLOSED_IMG             tmpImgOpened = FOLDER_OPENED_IMG         Case 1  'Agent             tmpImgClosed = ROUTINGAGENT_CLOSED_IMG             tmpImgOpened = ROUTINGAGENT_OPENED_IMG         Case 2  'Map             tmpImgClosed = ROUTINGMAPEXISTS_IMG             tmpImgOpened = ROUTINGMAPEXISTS_IMG     End Select End Sub '******************************************************************** ' Sub:          LoadStores ' ' Description:  Loads the stores into the FolderView. ' '******************************************************************** Private Function LoadStores() As Boolean     On Error GoTo LoadStores_Err:     Dim bReturnStatus As Boolean     'Messaging Objects     Dim objFoldersCol As Object       'Folders Collection     Dim objFolder As Object           'Folder Object     Dim objstore As Object            'Store Object     Dim objStoreRoot As Object        'RootFolder Object     Dim objInfoStores As Object       'InfoStores Collection     Dim objChildFoldersCol As Object  'Folders Collection     Dim objChildFolder As Object      'Folder Object     Dim objTemp As Object             'Temporary Object     Dim nodTopofStore As Object       'Node Object     Dim lmask As Long     Dim iStoreKey As Integer     Dim strFolderID As String     Dim iLoop As Integer     Dim sLongTermID As String     Me.MousePointer = vbHourglass     'Assume Successful     bReturnStatus = True     'Clear Treeview control     tvwFolders.Nodes.Clear     'Get infostore object     Set objInfoStores = CDOClass.Session.InfoStores     'Open all stores to speed access later     For Each objstore In objInfoStores         Set objTemp = objstore.RootFolder     Next     'Iterate through stores     For Each objstore In objInfoStores         If objstore.ProviderName = "Personal Folders" Then            'We don't allow them to place agent in a personal folder         Else             Set objStoreRoot = objstore.RootFolder             'Exit if store or root isn't found             If (objstore Is Nothing) Or (objStoreRoot Is Nothing) Then                 'Problem here.                 bReturnStatus = False                 GoTo ObjectCleanup             End If             'Set the top node.             'Loop through main folders.             Set nodTopofStore = tvwFolders.Nodes.Add(, , _                 objstore.ID, objstore.Name, ROOT_IMG, ROOT_IMG)             iStoreKey = nodTopofStore.Index             Set objFoldersCol = objStoreRoot.Folders             Set objFolder = objFoldersCol.GetFirst             If Not objFoldersCol Is Nothing Then ' loop through All                 'Add first-level folders to outline                 While Not objFolder Is Nothing                     'Don't display favorites                     If objFolder.Name <> "Favorites" Then                         sLongTermID = objFolder.ID                         If (Left$(sLongTermID, 2) = "EF") Then                             'High:  PR_LONGTERM_ENTRYID_FROM_TABLE =                              '&H6670                             'Low:   PT_BINARY = &H0102                             sLongTermID = objFolder.Fields.item( _                                 &H66700102)                         End If                         tmpIsAgent = CheckForRoutingAgent(objFolder)                         tmpIsAgent = CheckforRoutingMap(objFolder, _                             tmpIsAgent)                         SetFolderImage tmpIsAgent                         'Add node to treeview control                         Set nodTopofStore = tvwFolders.Nodes. _                             Add(objstore.ID, tvwChild, sLongTermID, _                             objFolder.Name, tmpImgClosed, _                             tmpImgOpened)                         'Check for subfolders                         Set objChildFoldersCol = objFolder.Folders                         'May not have access                         If Not (objChildFoldersCol Is Nothing) Then                              'Add the subfolders for this node                             LoadFolders objstore.ID, _                                 nodTopofStore.Key, _                                 nodTopofStore.Index                         End If                     End If                     Set objChildFoldersCol = Nothing                     Set objFolder = objFoldersCol.GetNext                 Wend             End If         End If     Next 'store ObjectCleanup:     Set objFoldersCol = Nothing     Set objFolder = Nothing     Set objstore = Nothing     Set objStoreRoot = Nothing     Set objInfoStores = Nothing     Set objChildFoldersCol = Nothing     Set objChildFolder = Nothing     Set objTemp = Nothing     Set nodTopofStore = Nothing     LoadStores = bReturnStatus     Me.MousePointer = vbNormal     'Make treeview visible     tvwFolders.Visible = True     Exit Function LoadStores_Err:     AppActivate App.Title     Select Case Err.Number         Case CdoE_NO_ACCESS, CdoE_NOT_FOUND, CdoE_FAILONEPROVIDER, _         35602             Err.Clear             Resume ObjectCleanup         Case Else             Call CDOClass.MapiErrorHandler( _                 "LoadStores in FrmFolders")             Err.Clear             'Resume Next             Me.MousePointer = vbNormal             bReturnStatus = False             Resume ObjectCleanup     End Select End Function Public Function CheckForRoutingAgent(objFolder) As Integer 'This function checks for any type of agent in the folder. 'It returns 1 if there is an agent or 0 if there is not.     Dim otmpEvents     Dim otmpBoundFolder     Dim otmpBindings     On Error GoTo CheckForRoutingAgent_Err     Set otmpEvents = oEvents     Set otmpBoundFolder = otmpEvents.BoundFolder(objFolder, True)     Set otmpBindings = otmpBoundFolder.Bindings     If otmpBindings.Count > 0 Then         CheckForRoutingAgent = 1     Else         CheckForRoutingAgent = 0     End If Exit Function CheckForRoutingAgent_Err:     'Most likely the error is from hitting the user's Outlook      'calendar folder     CheckForRoutingAgent = False End Function Public Function CheckforRoutingMap(objFolder, tmpCurrentType) _ As Integer 'This checks for Routing Maps only in the folder. 'It returns 2 if there is only a map.     On Error Resume Next     If tmpCurrentType <> 1 Then         'Check only folders with no agents         Set oHidden = objFolder.HiddenMessages         For Each oHide In oHidden             Err.Clear             tmpRouteMap = oHide.Fields("RouteMap")             If Err.Number = 0 Then                 'There is a map                 CheckforRoutingMap = 2                 Exit Function             End If         Next     End If     CheckforRoutingMap = tmpCurrentType End Function



Programming Microsoft Outlook and Microsoft Exchange
Programming Microsoft Outlook and Microsoft Exchange, Second Edition (DV-MPS Programming)
ISBN: 0735610193
EAN: 2147483647
Year: 1999
Pages: 101

flylib.com © 2008-2017.
If you may any questions please contact us: flylib@qtcs.net