The Account Tracking application
The first technique used by the Account Tracking application is
'**********************************************
' Global Declarations
'**********************************************
Dim oRestrictedContactItems
Dim oRestrictedTaskItems
Dim oExcel
Dim oSheet
Dim ComposeMode
Dim bWebExists
Dim oDefaultPage
Dim oWebBrowser
Dim oCurrentFolder
Dim olstAssignTaskName
Dim oNameSpace
Dim oDatabase
Dim oDatabaseEngine
Dim bUseDatabase 'Used to tell the application to use an
'external DB
Dim txtAccountName
Dim txtOriginalStreet, txtOriginalCity, txtOriginalState
Dim txtOriginalPostalCode, txtOriginalCountry
Dim oExcelChart
bUseDatabase = 0 'Tells the application to use an Access database.
'Set this to 1 to use a database.
ComposeMode = True 'Used to determine whether the application is in
'compose or read mode.
bWebExists = False 'Used to determine whether the WebBrowser control
'was successfully created.
|
The Item_Read event is used to determine whether the
'************************************************
'Sub Item_Read
'
'This is the standard Read event for an Outlook form.
'It checks to see whether the user is in read or compose mode
'on the form.
'************************************************
Sub Item_Read
'Check to see if the application is in compose mode
ComposeMode = False
End Sub
|
The Item_Open event in the Account Tracking form is used to perform some application initialization, in this order:
The entire Item_Open subroutine is shown here:
'************************************************
'Sub Item_Open
'
'This is the standard Outlook Open event. This subroutine
'sets some objects for use later in the app. Checks whether
'the WebBrowser control was successfully created and also checks
'to see whether there are names for the account team in the form.
'If the form is in compose mode, the subroutine selects the name of
'the account at the top of the form to draw user's
'attention to that field.
'************************************************
Sub Item_Open
'Get the default page of the application to use later
Set oDefaultPage = GetInspector.ModifiedFormPages( _
"Account Tracking")
Set oNameSpace = Application.GetNameSpace("MAPI")
'Initialize the WebBrowser control
set oWebBrowser = GetInspector.ModifiedFormPages( _
"Company Website").Controls("oWebBrowser")
'Check to see if the browser was successfully created; if so,
'enable the Go button for the company web site and the
'NetMeeting option
if err.number = 0 then
bWebExists = True
oDefaultPage.Controls("cmdGo").enabled = True
oDefaultPage.Controls("cmdNetMeetingContact").Visible = True
oDefaultPage.Controls("lblNetMeetingContact").Visible = True
oDefaultPage.Controls("cmdNetMeetingContact").Enabled = True
oDefaultPage.Controls("lblNetMeetingContact").Enabled = True
end if
'Get Current Folder
set oCurrentFolder = Application.ActiveExplorer.CurrentFolder
call cmdRefreshContactsList_Click
call cmdRefreshTasks_Click
'Check to see if any users are assigned to the account team and
'add them to assign task list
set olstAssignTaskName = oDefaultPage.Controls( _
"lstAssignTaskName")
CheckFor "txtAccountSalesRep"
CheckFor "txtAccountSE"
CheckFor "txtAccountConsultant"
CheckFor "txtAccountSupportEngineer"
CheckFor "txtAccountExecutive"
If not(ComposeMode) then
txtOriginalStreet = _
Item.UserProperties.Find("Account Street")
txtOriginalCity = _
Item.UserProperties.Find("Account City")
txtOriginalState = _
Item.UserProperties.Find("Account State")
txtOriginalPostalCode = _
Item.UserProperties.Find("Account Postal Code")
txtOriginalCountry = _
Item.UserProperties.Find("Account Country")
oDefaultPage.Controls("lblDistrict").visible = True
set oDistrict = oDefaultPage.Controls("lstDistrict")
oDistrict.visible = True
end if
If not(ComposeMode) and bUseDatabase then
txtAccountName = item.Subject
'Initialize DB
InitializeDatabase "c:\sales.mdb"
GetDatabaseInfo "[1998 Actual]", "cur1998ActualProd1", _
"cur1998ActualProd2","cur1998ActualProd3"
GetDatabaseInfo "[1999 Actual]", "cur1999ActualProd1", _
"cur1999ActualProd2","cur1999ActualProd3"
GetDatabaseInfo "[1998 Quota]", "cur1998QuotaProd1", _
"cur1998QuotaProd2","cur1998QuotaProd3"
end if
If ComposeMode Then
oDefaultPage.txtName.SetFocus
oDefaultPage.txtName.SelStart = 0
oDefaultPage.txtName.SelLength = 11
End If
End Sub
|
If you have enabled a database for the sales information, the
GetDatabaseInfo
subroutine is called to retrieve the sales information from the database and place this information into Outlook fields. This subroutine uses DAO 3.5 to query the database and retrieve the sales information associated with accounts previously entered in the database. Once this information is placed in the form, Outlook formula fields determine whether the current sales of the product are
'************************************************
'Sub GetDatabaseInfo
'
'This subroutine retrieves the product revenue information
'from the database using the passed-in table name as well as
'field names and the current account name from the open item.
'You can customize this subroutine to meet your specific needs.
'************************************************
Sub GetDatabaseInfo(TableName, FieldName1, FieldName2, FieldName3)
strSQL = "Select Product1, Product2, Product3 FROM " & _
TableName & " WHERE AccountName = '" & txtAccountName & "';"
Set oRS = oDatabase.OpenRecordset(strSQL)
If Err.Number <> 0 Then
MsgBox Err.Description & Err.Number & Chr(13) & _
"OpenRecordset failed"
Exit Sub
End If
oRS.MoveFirst
Item.UserProperties.Find(FieldName1).Value = oRS.Fields(0)
Item.UserProperties.Find(FieldName2).Value = oRS.Fields(1)
Item.UserProperties.Find(FieldName3).Value = oRS.Fields(2)
End Sub
|
Because Outlook does not natively support displaying an address book in its object library, the application needs to be extended with the CDO library, which will display address books and return the values selected by the user. To use CDO in the Account Tracking application, the VBScript code in the form has to create a CDO object by using the
CreateObject
method of the Outlook Application object. When the object is created, a subroutine starts a session using the CDO
Figure 7-8 Displaying the address book in an Outlook form by using CDO.
The following code shows how the address book is displayed using CDO:
'************************************************
'Sub FindAddress
'
'This subroutine takes the Outlook field that stores
'the returned value and the caption for the dialog box as
'well as the button text for the dialog box, and then it
'displays the AddressBook dialog box by using
'CDO
'************************************************
Sub FindAddress(FieldName, Caption, ButtonText)
On Error Resume Next
Set oCDOSession = application.CreateObject("MAPI.Session")
oCDOSession.Logon "", "", False, False, 0
txtCaption = Caption
if not err then
set orecip = oCDOSession.addressbook (Nothing, txtCaption, _
True, True, 1, ButtonText, "", "", 0)
end if
if not err then
item.userproperties.find(FieldName).value = orecip(1).Name
end if
oCDOSession.logoff
oCDOSession = Nothing
End Sub
|
After assigning internal people to the account team, the user can add new account contacts for the company. The application has a custom action that creates a reply in the folder by using the custom Account Contact form. Because you are using an action, the command for the action, Create New Account Contact, will appear on context
'**********************************************
'Sub cmdAddAccountContact_Click
'
'This subroutine creates a new contact and displays
'the form for the new contact as a modal dialog box
'**********************************************
sub cmdAddAccountContact_Click
Item.Save
Set AccountContactForm = item.Actions( _
"Create New Account Contact").Execute
AccountContactForm.Display(True)
call cmdRefreshContactsList_Click
end sub
|
When the form initially opens, or when users add or delete contacts or tasks in the folder, the ListBox control that contains these items must be refreshed and filled with the most recent information from the folder. To do this, the application calls subroutines that restrict the folder based on the item type and on the account the item belongs to. The application then programmatically fills the list box with the correct information for the account. The list box is shown in Figure 7-9.
Figure 7-9 The Account Contacts list box for the Account Tracking application. It is dynamically filled in using the contact items contained in the folder.
The following code shows the cmdRefreshContactsList subroutine at work:
'************************************************
'Sub cmdRefreshContactsList_Click
'
'This subroutine refreshes the list box of contacts by
'applying a restriction on the folder
'
'************************************************
Sub cmdRefreshContactsList_Click
'Initialize ListBox
set oListBox = oDefaultPage.Controls("lstContacts")
oListBox.Clear
oListBox.ColumnWidths = "0;172;140;80;120"
'Create search criteria
RestrictString = ""
RestrictString = "[Message Class] = " & _
"""IPM.Contact.Account contact"" and [Conversation] = """ & _
item.ConversationTopic & """"
Set oRestrictedContactItems = _
oCurrentFolder.Items.Restrict(RestrictString)
for i = 0 to oRestrictedContactItems.Count - 1
oListBox.AddItem
oListBox.Column(1,i) = oRestrictedContactItems(i+1).FullName
oListBox.Column(2,i) = oRestrictedContactItems(i+1).JobTitle
oListBox.Column(3,i) = _
oRestrictedContactItems(i+1).BusinessTelephoneNumber
oListBox.Column(4,i) = _
oRestrictedContactItems(i+1).Email1Address
next
End Sub
|
Because users of this application will want to perform many actions for the account contacts they create, the Account Tracking application provides the most common actions as default controls on the Account Contacts tab. The user can click the Email Contact link to e-mail a contact. This action uses the CreateItem method on the Application object to create an e-mail message, and then uses the name of the selected contact to fill in the address information for the e-mail.
If Word 97 is installed, the user can also send a letter to the contact by clicking the Send Letter To Contact link. This action takes advantage of Outlook by using the CommandBars collection on Outlook forms to trigger toolbar actions. Then, by using the
FindControl
method and the
Execute
method of the CommandBar object, the application launches the New Letter To Contact option from the Actions menu for a contact. This, in
Finally, the user can start a NetMeeting with the contact by clicking the NetMeeting This Contact link. This action uses the WebBrowser control. If the WebBrowser control is available and the user launches the action, the application uses VBScript in Outlook to automate the WebBrowser control, which starts NetMeeting and connects the user to the Account contact using the NetMeeting client.
The following code shows the subroutines that enable the user to send an e-mail or a letter and to set up a NetMeeting:
'************************************************
'Sub cmdEmailContact_Click
'
'This subroutine e-mails the selected account contact.
'If there is no selected contact, it displays an error.
'************************************************
Sub cmdEmailContact_Click
set oListBox = oDefaultPage.Controls("lstContacts")
if oListBox.ListIndex = -1 then
MsgBox "No selected account contact. Please select one.", _
48, "Email Account Contact"
else
set oItem = oRestrictedContactItems(oListBox.ListIndex + 1)
'Create an e-mail message
set oNewMessage = Application.CreateItem(0)
oNewMessage.Recipients.Add oItem.Email1Address
oNewMessage.Recipients.ResolveAll
oNewMessage.Display
end if
end Sub
'************************************************
'Sub cmdSendLettertoContact_Click
'
'The following subroutine uses the commandbars
'property to automate the Contact form in Outlook
'to select the Send Letter To A Contact menu
'command. This in turn launches the Word Letter
'Wizard.
'************************************************
Sub cmdSendLettertoContact_Click
set oListBox = oDefaultPage.Controls("lstContacts")
if oListBox.ListIndex = -1 then
MsgBox "No selected account contact. Please select one.", _
48, "Send letter to Account Contact"
else
set oItem = oRestrictedContactItems(oListBox.ListIndex + 1)
oItem.Display
oItem.GetInspector.CommandBars.FindControl(,2498).Execute
end if
end Sub
'************************************************
'Sub cmdNetMeetingContact_Click
'
'This subroutine checks the contact to see if the
'NetMeeting information is filled in and, if so, it
'automates the WebBrowser control to use the NetMeeting
'callto: syntax to start a NetMeeting
'************************************************
Sub cmdNetMeetingContact_Click
set oListBox = oDefaultPage.Controls("lstContacts")
if oListBox.ListIndex = -1 then
MsgBox "No selected account contact. Please select one.", _
48, "NetMeeting Account Contact"
else
set oItem = oRestrictedContactItems(oListBox.ListIndex + 1)
if oItem.NetMeetingAlias = "" then
MsgBox "The NetMeeting information is not filled" & _
" in for this contact.", 48, _
"NetMeeting Account Contact"
exit sub
end if
if oItem.NetMeetingServer = "" then
MsgBox "The NetMeeting information is not filled" & _
" in for this contact.", 48, _
"NetMeeting Account Contact"
exit sub
end if
on error resume next
txtNetMeetingAddress = "callto:" & oItem.NetMeetingServer _
& "/" & oItem.NetMeetingAlias
oWebBrowser.Navigate txtNetMeetingAddress
if err.number <> 0 then
msgbox "NetMeeting is either not installed or not" & _
" configured correctly.", 48, _
"NetMeeting Account Contact"
exit sub
end if
end if
End Sub
|
If the user has Excel 97 installed, the Account Tracking application can automate Excel to create charts, as was shown earlier in Figure 7-7. One way to start the chart creation process is to click the Create Sales Chart control on the Revenue tab of the application. An even easier way to start this process is to use the context menu in the Outlook window. Depending on the item type, you can right-click on an item and select Create Account Sales Charts without opening the item. The application does this through a custom action. The application captures the Item_CustomAction event when the user selects the Create Account Sales Charts action, and it calls its own subroutine to handle the action rather than displaying a response form. The subroutine then creates sales
'*************************************************
' Function Item_CustomAction
'
'This is the standard CustomAction event for an Outlook form.
'This event is captured so that the Create Account Sales Chart
'as well as the Print Account Summary actions can appear on the menu.
'However, these actions actually call VBScript functions. This
'is why these actions are canceled after the VBScript functions
'automate Excel to create the reports. Otherwise, a reply form
'would appear to the user.
'*************************************************
Function Item_CustomAction(ByVal Action, ByVal ResponseItem)
select case Action
case "Create Account Sales Charts"
cmdCreateSalesChart_Click()
'Disable the action so that a response form does not appear
Item_CustomAction = False
case "Print Account Summary"
cmdPrintAccountSummary_Click()
Item_CustomAction = False
end select
end Function
'************************************************
'Sub cmdCreateSalesChart_Click
'
'This subroutine responds to the Click event of the
'Create Sales Charts control. It automates Excel
'to create both a worksheet and embedded charts on that worksheet.
'You can modify this subroutine to meet your specific needs.
'************************************************
Sub cmdCreateSalesChart_Click
Set oExcel = Item.Application.CreateObject("Excel.Application")
oExcel.Visible = True
oExcel.Workbooks.Add
Set oSheet = oExcel.Workbooks(1).Worksheets("Sheet1")
'Set the title for the worksheet
oSheet.Activate
set oSheetTitle = oSheet.Range("A1")
oSheetTitle.Value = item.Subject & " Sales Summary"
oSheetTitle.Font.Bold = -1
oSheetTitle.Font.Size = 18
oSheetTitle.Font.Name = "Arial"
oExcel.Application.ActiveCell.Offset(2,0).Select
oExcel.Application.ActiveCell.Value = "Revenue Information"
oExcel.Application.ActiveCell.Font.Bold = -1
oExcel.Application.ActiveCell.Font.Name= "Arial"
oExcel.Application.ActiveCell.Font.Size = 11
oExcel.Application.ActiveCell.Font.Underline = 2
oExcel.Application.ActiveCell.Offset(1,0).Select
oSheet.Range("A6").Value = "Product 1"
oSheet.Range("A7").Value = "Product 2"
oSheet.Range("A8").Value = "Product 3"
oSheet.Range("B5").Value = "1998 Actual"
oSheet.Range("B6").Value = item.userproperties( _
"cur1998ActualProd1")
oSheet.Range("B7").Value = item.userproperties( _
"cur1998ActualProd2")
oSheet.Range("B8").Value = item.userproperties( _
"cur1998ActualProd3")
oSheet.Range("C5").Value = "1998 Quota"
oSheet.Range("C6").Value = item.userproperties( _
"cur1998QuotaProd1")
oSheet.Range("C7").Value = item.userproperties( _
"cur1998QuotaProd2")
oSheet.Range("C8").Value = item.userproperties( _
"cur1998QuotaProd3")
oSheet.Range("D5").Value = "1999 Actual"
oSheet.Range("D6").Value = item.userproperties( _
"cur1999ActualProd1")
oSheet.Range("D7").Value = item.userproperties( _
"cur1999ActualProd2")
oSheet.Range("D8").Value = item.userproperties( _
"cur1999ActualProd3")
'Create charts
set oChart = oSheet.ChartObjects.Add(250, 20, 200, 200)
oChart.Chart.ChartWizard oSheet.Range( _
"a6:B8"),5,,2,1,,,"Actual Product 1998"
set oChart = oSheet.ChartObjects.Add(0, 150, 200, 200)
oChart.Chart.ChartWizard oSheet.Range( _
"a6:A8, D6:D8"),5,,2,1,,,"Actual Product 1999"
set oChart = oSheet.ChartObjects.Add(250, 250, 200, 200)
oChart.Chart.ChartWizard oSheet.Range( _
"a6:A8, C6:C8"),5,,2,1,,,"Quota Product 1998"
set oChart = oSheet.ChartObjects.Add(500, 20, 200, 200)
oChart.Chart.ChartWizard oSheet.Range( _
"a6:c8"),3,,2,1,,,"Quota vs Actual 1998"
oSheet.ChartObjects(4).Chart.ChartType = 54
end Sub
|
When the user clicks the Print Account Summary control on the Account Tracking tab, an account summary is created in Excel. The Excel Account Summary sheet is shown in Figure 7-10.
Figure 7-10 The Excel Account Summary sheet, which is programmatically created by the Account Tracking application.
The code to create the Account Summary is shown here:
'**********************************************
'Sub cmdPrintAccountSummary_Click
'
'This subroutine calls the helper subroutine to
'print the Account Summary. You can replace the
'helper subroutine without having to replace the controls
'on the form.
'**********************************************
Sub cmdPrintAccountSummary_Click()
CreateExcelSheet
End Sub
'************************************************
'Sub ExcelPrintProductRevenue
'
'This subroutine is a helper subroutine that prints
'the passed-in product name as well as the current
'sales numbers. You can replace this subroutine
'with your own.
'************************************************
Sub ExcelPrintProductRevenue(ByVal txtType, txtProd1, txtProd2, _
txtProd3,curProd1,curProd2,curProd3)
oExcel.Application.ActiveCell.Value = txtType
oExcel.Application.ActiveCell.Font.Italic = -1
oExcel.Application.ActiveCell.Offset(1,1).Value = txtProd1
oExcel.Application.ActiveCell.Offset(1,1).Font.Bold = -1
oExcel.Application.ActiveCell(2,3).Value = curProd1
oExcel.Application.ActiveCell.Offset(2,1).Value = txtProd2
oExcel.Application.ActiveCell.Offset(2,1).Font.Bold = -1
oExcel.Application.ActiveCell(3,3).Value = curProd2
oExcel.Application.ActiveCell.Offset(3,1).Value = txtProd3
oExcel.Application.ActiveCell.Offset(3,1).Font.Bold = -1
oExcel.Application.ActiveCell(4,3).Value = curProd3
end Sub
'************************************************
'Sub CreateExcelSheet
'
'This subroutine automates Excel to create an Account
'Summary report. You can replace this subroutine
'with your own.
'************************************************
Sub CreateExcelSheet
Set oExcel = Item.Application.CreateObject("Excel.Application")
oExcel.Visible = True
oExcel.Workbooks.Add
Set oSheet = oExcel.Workbooks(1).Worksheets("Sheet1")
'Set the title for the worksheet
oSheet.Activate
set oSheetTitle = oSheet.Range("A1")
oSheetTitle.Value = item.Subject & " Account Summary"
oSheetTitle.Font.Bold = -1
oSheetTitle.Font.Size = 18
oSheetTitle.Font.Name = "Arial"
'Put in the printout date
oSheet.Range("A3").Value = "Printed on: " & Date
oSheet.Range("A3").Font.Bold = -1
oSheet.Range("A3").Font.Name = "Arial"
oSheet.Range("A3").Font.Size = 12
oSheet.Range("A3").Font.Color = RGB(0,0,255)
'Put in the date the item was created
oSheet.Range("A4").Value = "Account created on: " & _
item.CreationTime
oSheet.Range("A4").Font.Bold = -1
oSheet.Range("A4").Font.Name = "Arial"
oSheet.Range("A4").Font.Size = 12
oSheet.Range("A4").Font.Color = RGB(0,0,255)
'Put in the date the item was last modified
oSheet.Range("A5").Value = "Account modified on: " & _
item.LastModificationTime
oSheet.Range("A5").Font.Bold = -1
oSheet.Range("A5").Font.Name = "Arial"
oSheet.Range("A5").Font.Size = 12
oSheet.Range("A5").Font.Color = RGB(0,0,255)
oSheet.Range("A7").Activate
'Retrieve contact information
oExcel.Application.ActiveCell.Offset(1,0).Select
oExcel.Application.ActiveCell.Value = "Account Contacts"
oExcel.Application.ActiveCell.Font.Bold = -1
oExcel.Application.ActiveCell.Font.Name= "Arial"
oExcel.Application.ActiveCell.Font.Size = 11
oExcel.Application.ActiveCell.Font.Underline = 2
oExcel.Application.ActiveCell.Offset(1,0).Select
'Refresh the contact listbox
cmdRefreshContactsList_Click
'Retrieve the data from the listbox
set oPage = GetInspector.ModifiedFormPages("Account Tracking")
set oListBox = oPage.lstContacts
If oListBox.ListCount > 0 Then
oExcel.Application.ActiveCell.Value = "Contact Name"
oExcel.Application.ActiveCell.Font.Bold = -1
oExcel.Application.ActiveCell.Offset(0,1).Value = _
"Job Title"
oExcel.Application.ActiveCell.Offset(0,1).Font.Bold = -1
oExcel.Application.ActiveCell.Offset(0,2).Value = _
"Business Phone"
oExcel.Application.ActiveCell.Offset(0,2).Font.Bold = -1
oExcel.Application.ActiveCell.Offset(0,3).Value = _
"Email Address"
oExcel.Application.ActiveCell.Offset(0,3).Font.Bold = -1
oExcel.Application.ActiveCell.Offset(1,0).Activate
For intLB = 0 to oListBox.ListCount -1
oExcel.Application.ActiveCell.Value = _
oListBox.Column(1,intLB)
oExcel.Application.ActiveCell.Offset(0,1).Value = _
oListBox.Column(2,intLB)
oExcel.Application.ActiveCell.Offset(0,2).Value = _
oListBox.Column(3,intLB)
oExcel.Application.ActiveCell.Offset(0,3).Value = _
oListBox.Column(4,intLB)
oExcel.Application.ActiveCell.Offset(1,0).Activate
Next
Else
oExcel.Application.ActiveCell.Value = _
"No contacts for this account"
End If
'Retrieve revenue information
oExcel.Application.ActiveCell.Offset(2,0).Select
oExcel.Application.ActiveCell.Value = "Revenue Information"
oExcel.Application.ActiveCell.Font.Bold = -1
oExcel.Application.ActiveCell.Font.Name= "Arial"
oExcel.Application.ActiveCell.Font.Size = 11
oExcel.Application.ActiveCell.Font.Underline = 2
oExcel.Application.ActiveCell.Offset(1,0).Select
'Retrieve the user properties for the revenue information
set ouserprop = item.userproperties
ExcelPrintProductRevenue "1998 Actual","Product1","Product2", _
"Product3",ouserprop("cur1998ActualProd1"), _
ouserprop("cur1998ActualProd2"), _
ouserprop("cur1998ActualProd3")
oExcel.Application.ActiveCell.Offset(5,0).Select
ExcelPrintProductRevenue "1999 Actual","Product1","Product2", _
"Product3",ouserprop("cur1999ActualProd1"), _
ouserprop("cur1999ActualProd2"), _
ouserprop("cur1999ActualProd3")
oExcel.Application.ActiveCell.Offset(5,0).Select
ExcelPrintProductRevenue "1998 Quota","Product1","Product2", _
"Product3",ouserprop("cur1998QuotaProd1"), _
ouserprop("cur1998QuotaProd2"), _
ouserprop("cur1998QuotaProd3")
'Format the output
oSheet.Columns("A:B").EntireColumn.AutoFit
oSheet.Columns("B:B").HorizontalAlignment = -4152
oSheet.Range("A1:F1").Select
oSheet.Range("A1:F1").HorizontalAlignment=7
End Sub
|
When the user is finished using the application, the Item_Close event for the application is invoked. In the event handler, the application checks to see whether the user has updated any account address information. If the user has updated information, the application prompts the user about whether she wants to update all the contacts for that specific account in the folder. If the user answers yes, all the accounts are updated by using the properties of the standard Outlook contact. Figure 7-11 shows the message box that is displayed when the user changes the address in the Account Tracking form.
Figure 7-11 If the user wants to change the default address for each contact, this message box prompts the user about whether to change the addresses of all associated contacts for the account.
In the code that
'************************************************
'Function Item_Close
'
'This function fires on the standard Outlook close
'event and prompts the user about whether to update
'all contacts for the company if the user changed the
'master address for the company. This routine will
'update only the contacts that have the same text in
'the address fields as the original since users can
'change the address fields to reflect different
'locations or addresses for customers. This function
'also cleans up any open database objects that are left.
'************************************************
Function Item_Close()
boolSomethingDirty = 0 'False
If not(ComposeMode) then
'Divided into multiple ifs to pinpoint changed property on
'exit for faster performance when updating
If oDefaultPage.Controls("txtStreet").Value <> _
txtOriginalStreet then
boolStreetIsDirty = 1
boolSomethingDirty = 1
End if
if oDefaultPage.Controls("txtCity").Value <> _
txtOriginalCity then
boolCityIsDirty = 1
boolSomethingDirty = 1
End if
if oDefaultPage.Controls("txtState").Value <> _
txtOriginalState then
boolStateIsDirty = 1
boolSomethingDirty = 1
End if
if oDefaultPage.Controls("txtPostalCode").Value <> _
txtOriginalPostalCode then
boolPostalCodeIsDirty = 1
boolSomethingDirty = 1
End if
if oDefaultPage.Controls("lstCountry").Value <> _
txtOriginalCountry then
boolCountryIsDirty=1
boolSomethingDirty = 1
End if
If boolSomethingDirty then
'Make sure the user wants to update all the
'contact addresses
intResponse = msgbox("The account address " & _
"information has changed. Outlook can update " & _
"all the contacts for this account with " & _
"the new address information automatically." & _
" However, if there are any changes to the " & _
"address information in the contact that do " & _
"not match the original address for the " & _
"account, Outlook will skip these messages. Do " & _
"you want Outlook to update your accounts now?", _
292, "Update Account Contacts")
if intResponse = 6 then 'Yes
for counter = 1 to oRestrictedContactItems.Count
boolSaveItem = 0
set oItem = _
oRestrictedContactItems.Item(counter)
if boolStreetIsDirty then
if oItem.BusinessAddressStreet = _
txtOriginalStreet then
oItem.BusinessAddressStreet = _
oDefaultPage.Controls("txtStreet").Value
boolSaveItem = 1
end if
end if
if boolCityIsDirty then
if oItem.BusinessAddressCity = _
txtOriginalCity then
oItem.BusinessAddressCity = _
oDefaultPage.Controls("txtCity").Value
boolSaveItem = 1
end if
end if
if boolStateIsDirty then
if oItem.BusinessAddressState = _
txtOriginalState then
oItem.BusinessAddressState = _
oDefaultPage.Controls("txtState").Value
boolSaveItem = 1
end if
end if
if boolPostalCodeIsDirty then
if oItem.BusinessAddressPostalCode = _
txtOriginalPostalCode then
oItem.BusinessAddressPostalCode = _
oDefaultPage.Controls( _
"txtPostalCode").Value
boolSaveItem = 1
end if
end if
if boolCountryIsDirty then
if oItem.BusinessAddressCountry = _
txtOriginalCountry then
oItem.BusinessAddressCountry = _
oDefaultPage.Controls("lstCountry").Value
boolSaveItem = 1
end if
end if
If boolSaveItem then
'Make sure address information is only
'parsed once by Outlook
oItem.Save
end if
next
end if
end if
end if
'Close the database if enabled
if ComposeMode=False and bUseDatabase then
oDatabase.Close
set oDatabaseEngine = Nothing
end if
End Function
|