Making Client-Requested Changes


After the client has spent some time working in the application, he or she will probably request some new features. Sometimes the requests spring from changes to business procedures, and sometimes the client realizes that existing procedures can be made more efficient after working with the application in its new format.

Application-Specific Changes

Usually, after you complete an application’s tables and create some forms for data entry, the client gets a copy of the database and starts entering data (for the case where you need to write code or create queries to import old data, see Chapter 10, Moving Old Data into a New Database). Generally, after working with the application, the client will request some changes. For example, in the Toy Workshop database, after entering a few orders, the client asked for a display of the available inventory for a toy.

To display the available inventory, I created a subform (fsubToyInventory) with tblToys as its record source, linked on ToyID. I could have just placed the UnitsInStock field on the form—that would have satisfied the letter of the client’s request—but looking at the field list, I saw a few other fields that would also be useful, UnitsOnOrder and SellPrice. In cases like this, I generally go ahead and make whatever changes seem reasonable—the only exception being cases where a client is absolutely insistent on pre-approving any changes. I dragged ToyID, UnitsInStock, UnitsOnOrder, and SellPrice to the subform, and made ToyID invisible, using the Lock Wizard, as shown in Figure 8.11.

click to expand
Figure 8.11

The reason for making ToyID invisible, instead of just omitting it, is that in case of problems (such as the subform not displaying the appropriate data) I can temporarily make it visible for debugging purposes. The yellow color reminds me that this field should be made invisible before finalizing the form.

I placed the subform on fpriOrders in the sample Toy Workshop database, under the cboToyID combobox (after moving down the other controls) and rearranged the controls on the subform and the subform itself to save space. I locked the subform and made its back color light blue as a visual indicator that it was locked. fpriOrders with the new Toy Inventory subform is shown in Figure 8.12.

click to expand
Figure 8.12

The new subform will correctly display toy inventory when navigating from record to record, but it doesn’t refresh automatically when a new toy is selected from cboToyID; to do that, the combobox’s AfterUpdate event procedure needs a line that requeries the subform. I added this line to the existing event procedure, which also copies the toy’s price from tblToys to the ToyPrice field on fpriOrders. The ToyPrice field can be edited as needed to adjust the selling price for an order.

 Private Sub cboToyID_AfterUpdate() On Error GoTo ErrorHandler        Dim curToyPrice As Currency        curToyPrice = Nz(Me![cboToyID].Column(3))    Me![ToyPrice] = curToyPrice    Me![txtToyPrice].Requery    Me![subToyInventory].Requery     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

Now that we can see the available inventory, some more coding is called for to prevent placing an order for more toys than are available. This code could be run from the BeforeUpdate event of the txtToyQuantity text box, or perhaps on the form’s BeforeUpdate event. I would write this code without conferencing with the client because it is simple to do and obviously needed. If the client wants serious error trapping, I could make a special form for creating a new order, either bound to a temporary table or storing its values in variables, and only transfer the data to a new record in tblOrders after checking that all fields have correct data (I wouldn’t go ahead with this without checking with the client because it is a more time-consuming project). (See Chapter 7, Writing VBA Code in Modules, for more information on creating a separate form for entering new records.) Another possibility would be triggering toy orders to vendors if there isn’t enough inventory to fill an order—again, I would check whether the client wants this feature before doing it.

For now, a simple BeforeUpdate event procedure for txtToyQuantity will do.

 Private Sub txtToyQuantity_BeforeUpdate(Cancel As Integer) On Error GoTo ErrorHandler        Dim lngAvailable As Long    Dim lngNeeded As Long    Dim strPrompt As String    Dim strTitle As String        lngAvailable = Nz(Me![subToyInventory]![UnitsInStock])    lngNeeded = Nz(Me![txtToyQuantity].Value)    If lngAvailable < lngNeeded Then       strTitle = "Not enough inventory"       strPrompt = lngNeeded & " needed; only " & lngAvailable & " available"       MsgBox strPrompt, vbOKOnly, strTitle       Me![txtToyQuantity].Undo       Cancel = True    End If     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

I also added a locked text box to display the total price for the toy order (ToyQuantity * ToyPrice), with a control source of =[ToyQuantity]*[ToyPrice].

Important

If you get an error message for a calculated field, it may be missing an equal sign. All calculated control source expressions must start with an equal sign.

If there is enough inventory to provide the desired quantity of a toy, then an AfterUpdate event procedure is also needed to deduct the amount just ordered from inventory. I moved the declarations from the BeforeUpdate event procedure to the Declarations section of the Code Behind Forms module because they will also be used in the AfterUpdate event procedure. The txtToyQuantity AfterUpdate event procedure is:

 Private Sub txtToyQuantity_AfterUpdate() On Error GoTo ErrorHandler        Dim strToyID As String    Dim dbs As DAO.Database    Dim rst As DAO.Recordset    Dim strSearch As String        ‘Check that a toy has been selected and an amount entered.    strToyID = Nz(Me![ToyID])    lngNeeded = Nz(Me![txtToyQuantity].Value)    If lngNeeded = 0 Then       GoTo ErrorHandlerExit    ElseIf strToyID = "" Then       GoTo ErrorHandlerExit    Else       strSearch = "[ToyID] = " & Chr$(39) & strToyID & Chr$(39)       Debug.Print "Search string: " & strSearch    End If        Set dbs = CurrentDb    Set rst = dbs.OpenRecordset("tblToys", dbOpenDynaset)    rst.FindFirst strSearch    If rst.NoMatch = True Then       strTitle = "Toy not found"       strPrompt = "Can’t find Toy ID " & strToyID & " in tblToys"       MsgBox strPrompt, vbOKOnly, strTitle       GoTo ErrorHandlerExit    Else       ‘Found the toy; ask for confirmation of reducing inventory.       strTitle = "Use inventory"       strPrompt = "Take " & lngNeeded & " of Toy ID " & strToyID           & " from inventory for this order?"       intReturn = MsgBox(strPrompt, vbOKCancel, strTitle)       If intReturn = vbCancel Then          Me![txtToyQuantity].Value = Null          GoTo ErrorHandlerExit       ElseIf intReturn = vbOK Then          rst.Edit rst![UnitsInStock] = rst![UnitsInStock] - lngNeeded          rst.Update          rst.Close          Me![subToyInventory].Requery       End If    End If     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

This procedure first checks that a toy has been selected and a nonzero amount entered, and exits the procedure if either test fails. If the tests are passed, a search string is created for searching for the selected toy in tblToys, using the Chr$(39) function to wrap the Toy ID with single quotes. A Debug.Print statement is used to display the search string in the Immediate window, which lets you inspect it, in case it isn’t working right.

Next, a DAO recordset is set up based on tblToys, and the strSearch variable is used with the FindFirst method to attempt to locate the selected toy in tblToys. If it isn’t found, an informative message is popped up, and the procedure is exited. If the record is found, an informative message is popped up to confirm removing the specified amount from inventory. If the user clicks Cancel, the amount is cleared from txtToyQuantity, and the procedure is exited. If the user clicks OK, the tblToys record is edited to subtract the amount needed from the amount in the UnitsInStock field, and to store the resulting amount back in UnitsInStock. The record is updated, the recordset closed, and the subToyInventory subform is requeried to reflect the change in the table.

At this point, the client reviews the modified form and suggests that the confirmation is premature before the other order information has been entered (a good point!), so I move the toy inventory and quantity controls down lower on the form. Some more checking is needed to ensure that a customer, employee, and the three dates have been filled in. I could modify the txtToyQuantity BeforeUpdate event procedure, but it’s less cumbersome to just make txtToyQuantity disabled initially, and enable it only after all the relevant fields have been filled in. This is done by calling a procedure called CheckData (listed below) from various control AfterUpdate procedures. The modified fpriOrders is shown in Figure 8.13, with the confirmation message for removing items from inventory.

click to expand
Figure 8.13

The entire Code Behind Forms module for fpriOrdersfollows. There is no error trapping for the calls to Sub procedures, because they have their own error trapping.

 Option Compare Database Option Explicit Dim lngAvailable As Long Dim lngNeeded As Long Dim strPrompt As String Dim strTitle As String Dim intReturn As Integer Private Sub EnableShippingAddress() On Error GoTo ErrorHandler        Dim lngCustomerID As Long        lngCustomerID = Nz(Me![cboCustomerID])    If lngCustomerID = 0 Then       Me![cboShipAddressID].Enabled = False    Else       Me![cboShipAddressID].Enabled = True       Me![cboShipAddressID].Requery    End If     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub Private Sub cboCustomerID_AfterUpdate()    Call EnableShippingAddress    Call EnableQuantity End Sub Private Sub cboEmployeeID_AfterUpdate()    Call EnableQuantity End Sub Private Sub cboSelect_AfterUpdate() On Error GoTo ErrorHandler        Dim strSearch As String    strSearch = "[OrderID] = " & Me![cboSelect]    ‘Find the record that matches the control    Me.RecordsetClone.FindFirst strSearch    Me.Bookmark = Me.RecordsetClone.Bookmark     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub Private Sub cboShipAddressID_AfterUpdate() On Error GoTo ErrorHandlerExit    On Error Resume Next    DoCmd.RunCommand acCmdSaveRecord    Debug.Print "Customer ID: " & Me![CustomerID]    Debug.Print "Ship Address ID: " & Me![ShipAddressID]    Me![subSelectedShippingAddress].Requery     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub Private Sub cboToyID_AfterUpdate() On Error GoTo ErrorHandler        Dim curToyPrice As Currency        curToyPrice = Nz(Me![cboToyID].Column(3))    Me![ToyPrice] = curToyPrice    Me![txtToyPrice].Requery    Me![subToyInventory].Requery    Call EnableQuantity     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub Private Sub cmdClose_Click() On Error GoTo ErrorHandler    Dim prj As Object    Set prj = Application.CurrentProject    If prj.AllForms("fmnuMain").IsLoaded Then       Forms![fmnuMain].Visible = True    Else       DoCmd.OpenForm "fmnuMain"    End If ErrorHandlerExit:    DoCmd.Close acForm, Me.Name    Exit Sub ErrorHandler:    If Err.Number = 2467 Then       Resume ErrorHandlerExit    Else       MsgBox "Error No: " & Err.Number & "; Description: "  & Err.Description       Resume ErrorHandlerExit    End If End Sub Private Sub Form_BeforeInsert(Cancel As Integer) On Error GoTo ErrorHandler              Me![txtToyQuantity].Enabled = False ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub Private Sub Form_Current() On Error GoTo ErrorHandlerExit    Me![cboSelect].Value = Null    Call EnableShippingAddress    Call EnableQuantity     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub Private Sub Form_Load() On Error Resume Next    DoCmd.RunCommand acCmdSizeToFitForm     End Sub Private Sub txtOrderDate_AfterUpdate()    Call EnableQuantity End Sub Private Sub txtPromisedByDate_BeforeUpdate(Cancel As Integer)    Call EnableQuantity End Sub Private Sub txtRequiredByDate_BeforeUpdate(Cancel As Integer)    Call EnableQuantity End Sub Private Sub txtToyQuantity_AfterUpdate() On Error GoTo ErrorHandler        Dim strToyID As String    Dim dbs As DAO.Database    Dim rst As DAO.Recordset    Dim strSearch As String        strToyID = Nz(Me![ToyID])    lngNeeded = Nz(Me![txtToyQuantity].Value)    Set dbs = CurrentDb    Set rst = dbs.OpenRecordset("tblToys", dbOpenDynaset)    strSearch = "[ToyID] = " & Chr$(39) & strToyID & Chr$(39)    rst.FindFirst strSearch    If rst.NoMatch = True Then       strTitle = "Toy not found"       strPrompt = "Can’t find Toy ID " & strToyID & " in tblToys"       MsgBox strPrompt, vbOKOnly, strTitle       GoTo ErrorHandlerExit    Else       ‘Found the toy; ask for confirmation of reducing inventory       strTitle = "Use inventory"       strPrompt = "Take " & lngNeeded & " of Toy ID " & strToyID           & " from inventory for this order?"       intReturn = MsgBox(strPrompt, vbOKCancel, strTitle)       If intReturn = vbCancel Then          Me![txtToyQuantity].Value = Null          GoTo ErrorHandlerExit       ElseIf intReturn = vbOK Then          rst.Edit          rst![UnitsInStock] = rst![UnitsInStock] - lngNeeded          rst.Update          rst.Close          Me![subToyInventory].Requery       End If    End If     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub Private Sub txtToyQuantity_BeforeUpdate(Cancel As Integer) On Error Resume Next        Dim strToyID As String    Dim dbs As DAO.Database    Dim rst As DAO.Recordset    Dim strSearch As String        ‘Check that an amount has been entered    strToyID = Nz(Me![ToyID])    lngNeeded = Nz(Me![txtToyQuantity].Value)    lngAvailable = Nz(Me![subToyInventory]![UnitsInStock])    If lngNeeded = 0 Then       GoTo ErrorHandlerExit    Else       strSearch = "[ToyID] = " & Chr$(39) & strToyID & Chr$(39)       Debug.Print "Search string: " & strSearch    End If        If lngAvailable < lngNeeded Then       strTitle = "Not enough inventory"       strPrompt = lngNeeded & " needed; only " & lngAvailable & " available"       MsgBox strPrompt, vbOKOnly, strTitle       Me![txtToyQuantity].Undo       Cancel = True    End If     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub Sub CheckData() On Error GoTo ErrorHandler        strTitle = "Missing data"    If Nz(Me![cboToyID].Value) = "" Then       strPrompt = "Please select a toy"       MsgBox strPrompt, vbOKOnly, strTitle       Me![cboToyID].SetFocus       GoTo ErrorHandlerExit    End If        If Nz(Me![cboCustomerID].Value) = 0 Then       strPrompt = "Please select a customer"       MsgBox strPrompt, vbOKOnly, strTitle       Me![cboCustomerID].SetFocus       GoTo ErrorHandlerExit    End If        If Nz(Me![cboEmployeeID].Value) = "" Then       strPrompt = "Please select an employee"       MsgBox strPrompt, vbOKOnly, strTitle       Me![cboEmployeeID].SetFocus       GoTo ErrorHandlerExit    End If        If Nz(Me![txtOrderDate].Value) = "" Then       strPrompt = "Please enter an order date"       MsgBox strPrompt, vbOKOnly, strTitle       Me![txtOrderDate].SetFocus       GoTo ErrorHandlerExit    End If        If Nz(Me![txtRequiredByDate].Value) = "" Then       strPrompt = "Please enter a required-by date"       MsgBox strPrompt, vbOKOnly, strTitle       Me![txtRequiredByDate].SetFocus       GoTo ErrorHandlerExit    End If        If Nz(Me![txtPromisedByDate].Value) = "" Then       strPrompt = "Please enter a required-by date"       MsgBox strPrompt, vbOKOnly, strTitle       Me![txtPromisedByDate].SetFocus       GoTo ErrorHandlerExit    End If        If Nz(Me![txtToyQuantity].Value) = 0 Then       strPrompt = "Please enter an amount to order"       MsgBox strPrompt, vbOKOnly, strTitle       Me![txtToyQuantity].SetFocus       GoTo ErrorHandlerExit    End If        ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub Sub EnableQuantity() On Error GoTo ErrorHandler        If Nz(Me![cboToyID].Value) = "" Then       Me![txtToyQuantity].Enabled = False       GoTo ErrorHandlerExit    End If        If Nz(Me![cboCustomerID].Value) = 0 Then       Me![txtToyQuantity].Enabled = False       GoTo ErrorHandlerExit    End If        If Nz(Me![cboEmployeeID].Value) = "" Then       Me![txtToyQuantity].Enabled = False       GoTo ErrorHandlerExit    End If        If Nz(Me![txtOrderDate].Value) = "" Then       Me![txtToyQuantity].Enabled = False       GoTo ErrorHandlerExit    End If        If Nz(Me![txtRequiredByDate].Value) = "" Then       Me![txtToyQuantity].Enabled = False       GoTo ErrorHandlerExit    End If        If Nz(Me![txtPromisedByDate].Value) = "" Then       Me![txtToyQuantity].Enabled = False       GoTo ErrorHandlerExit    End If        Me![txtToyQuantity].Enabled = True        ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

Standard Changes

Certain application features are quite likely to be needed at some point in an application, even though the client may not have originally requested them, or may even have specifically stated that they would not be needed. Some of these features are so commonly needed (database backup, generating Word letters, filtering reports by a date range) that I have built them into my standard main menu, which is created for an application by running the Menu Manager add-in. (See Chapter 6, Printing Data with Reports, for more details on using this add-in.) This eliminates the need to discuss why a certain feature is a good idea (and why the client should pay for its development)—it’s just there, and the client can use it or not, as he or she prefers. Splitting a name into separate fields is one of these often-needed changes, and another is the need to generate Word letters to customers.

Adding More Name Fields

At the initial Q&A session for setting up the Toy Workshop application, the client said that there was no need to store prefixes and suffixes for names in most of the tables in the application that store name information. The tblCustomers, tblEmployees, and tblVendors tables don’t have Prefix and Suffix fields. However, tblMailingList does have these fields, because it was anticipated that Word letters might be sent to the mailing list at some point. Now the Toy Workshop client has hired a new employee whose name includes a suffix (“Jr.”), and he wants to send Word letters to vendors and possibly customers as well as to people on his mailing list.

This means that the tblEmployees, tblVendors, and tblCustomers tables need a Prefix and Suffix field so that the “Jr.” can be stored in the proper field and letters can be addressed using the appropriate prefix (Mr., Ms., Dr., and so on). Currently there is just a ContactName field in tblVendors, so the information in that field needs to be extracted and put into separate fields, which can be done with query expressions modified from the queries in the Query Expressions sample database for Chapter 4, Sorting and Filtering Data with Queries.

There are several stages to making these changes. First, the new fields need to be added to the tables. Next, controls bound to the new fields need to be placed on various forms. And finally, queries and reports that display name data need to be modified to include the Prefix and Suffix fields, where relevant. The first step is to open each table with name fields in Design view and add the new fields. Figure 8.14 shows tblCustomers with the new ContactPrefix and ContactSuffix fields.

click to expand
Figure 8.14

If you try to modify the structure of a table while an object bound to that table is open, you will get the error message “You can’t open the table ‘tblInfo’ for modification” (with the name of the table you are trying to modify). Close any objects bound to the table, and try again. If you still get the same error message, closing the database and reopening using Shift-Enter to bypass startup code should do the trick.

Similar fields are also added to tblEmployees and tblVendors (leaving the original ContactName field in tblVendors, because it contains the whole name that needs to be split up among the new fields). After adding the new fields to the tables, forms bound to the tables need new Prefix and Suffix controls. Figure 8.15 shows the main Employees form, with the new Prefix and Suffix fields, for the employee with the Jr. suffix.

click to expand
Figure 8.15

The Customer Address tab on frmCustomers also needs two more controls, for the ContactPrefix and ContactSuffix fields. Before modifying the final form, frmVendors, an update query is needed to fill the separate fields with first name and last name information from the ContactName field. I started by importing qrySplitNameComponents from the Query Expressions sample database for Chapter 4, Sorting and Filtering Data with Queries. Next, create a new query based on tblVendors, and create expressions for the new ContactFirstName and ContactLastName fields. For ContactFirstName, the FirstNameF expression from qrySplitNameComponents is fine, if we simply substitute ContactName for FirstNameFirst, as shown in Figure 8.16.

click to expand
Figure 8.16

For the remaining name fields, I could use the full set of fields in qrySplitNameComponents, pasting the MiddleNamePlusF expression into the expressions for the MiddleNameF and LastNameF fields as needed. However, eyeballing tblVendors shows that in fact there are no middle names in the ContactName field for any records, so instead I’ll create a simpler LastName expression, on the assumption that the last name starts after the space in the ContactName field. The expressions for extracting the first name and last name from the ContactName field are:

FirstName: IIf(InStr([ContactName],Chr$(32))>0,Mid([ContactName],1,_InStr([ContactName],Chr$(32))-1),[ContactName]) LastName: IIf(InStr([ContactName],Chr$(32))>0,Mid([ContactName],_InStr([ContactName],Chr$(32))+1),[ContactName])

After checking the query results in Datasheet view, to see that the correct name components are being extracted (as shown in Figure 8.17), the query can be converted to an update query, by moving the field expressions to the Update To column of the ContactFirstName and ContactLastName fields.

click to expand
Figure 8.17

The update query is shown in Design view in Figure 8.18.

click to expand
Figure 8.18

After running the query, the tblVendors table now has data in the ContactFirstName and ContactLastName fields; the other fields will have to be filled in manually, when and if the information is available. The redundant ContactName field can now be removed from tblVendors. frmVendors now needs controls to display the data from the separate name fields, and its txtContactName control can be removed. The modified frmVendors form is shown in Figure 8.19.

click to expand
Figure 8.19

Customizing the Main Menu’s Word Letters Component

The client may not have originally planned on sending Word letters to clients, but as the application is used and more features are added to it, quite often there will be a need to generate Word letters. My standard main menu has a Word Letters section that can be customized to send a letter to a recipient selected from a table in the database.

The main menu of the Toy Workshop database already contains the controls and code needed to generate a letter to a single recipient, using a Word template selected from a combobox and a table of sample data. To customize this component to work with your application’s data, you need to make several changes:

  1. Add the required doc properties to the client’s Word template(s).

  2. Add the templates to tlkpLetters.

  3. Replace the sample zstblSampleData table in cboLetter’s RowSource property with a reference to the database table that contains the letter recipient data.

  4. Modify the cmdLetters Click event procedure (if necessary), depending on what fields need to be printed on the Word letter.

The original cmdLetters Click event procedure is:

 Private Sub cmdLetters_Click() On Error GoTo ErrorHandler    Dim strLetter As String    Dim strRecipient As String    Dim strTestFile As String    Dim ctl As Access.Control    Dim docs As Word.Documents    Dim prps As Object    Dim strDocsPath As String    Dim strTemplatePath As String        ‘Check that a letter has been selected    strLetter = Nz(Me![cboLetters])    Set ctl = Me![cboLetters]    If strLetter = "" Then       ctl.SetFocus       ctl.Dropdown       GoTo ErrorHandlerExit    End If        ‘Check that a recipient has been selected.    strRecipient = Nz(Me![cboRecipients])    Set ctl = Me![cboRecipients]    If strRecipient = "" Then       ctl.SetFocus       ctl.Dropdown       GoTo ErrorHandlerExit    End If           Set appWord = GetObject(, "Word.Application")    strDocsPath = DocsDir    strTemplatePath = TemplateDir    strLetter = strTemplatePath & strLetter        ‘Check for existence of template in template folder,    ‘and exit if not found    strTestFile = Nz(Dir(strLetter))    Debug.Print "Test file: " & strTestFile    If strTestFile = "" Then       MsgBox strLetter & " template not found; can’t create letter"       GoTo ErrorHandlerExit    End If        Set docs = appWord.Documents    docs.Add strLetter    Set ctl = Me![cboRecipients] On Error Resume Next    Set prps = appWord.ActiveDocument.CustomDocumentProperties    prps.Item("Name").Value = Nz(ctl.Column(6))    prps.Item("Street").Value = Nz(ctl.Column(1))    prps.Item("City").Value = Nz(ctl.Column(2))    prps.Item("State").Value = Nz(ctl.Column(3))    prps.Item("Zip").Value = Nz(ctl.Column(4))    prps.Item("Country").Value = Nz(ctl.Column(5))     On Error GoTo ErrorHandlerExit    ‘Update fields and make letter visible    With appWord       .Visible = True       .Selection.WholeStory       .Selection.Fields.Update       .Visible = True       .Activate    End With     ErrorHandlerExit:    Exit Sub ErrorHandler:    If Err = 429 Then       ‘Word is not running; open Word with CreateObject       Set appWord = CreateObject("Word.Application")       Resume Next    Else       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description       Resume ErrorHandlerExit    End If End Sub 

The cboLetters combobox has a lookup table, tlkpLetters, as its row source. When a template is selected from this combobox, the code looks for the template in the folder designated as the Word UserTemplates folder (see Chapter 11, Working with Word, for more details on the TemplateDir function that is used to find this folder). If the template is found, a new letter is created from it, and a set of doc properties is filled with name and address data from the selected recipient from cboRecipients.

There are two ways you can customize Word templates to work with this code: add the appropriate doc properties to existing templates, or make copies of the sample template (Test Letter.dot) and modify their text as needed. If the templates aren’t very complicated, it’s easier to make copies of Test Letter.dot and add the appropriate logo, text, headers, and footers, but if the templates are complex, you’ll probably want to add the necessary doc properties to them.

To quickly (and accurately) copy doc properties from one Word template to another, you can use the procedure that follows, run from a standard module. It is in basUtilities in the Toy Workshop sample database. Modify the template path, original document name, and target document name as required, and run the procedure from the module window with the F5 hot key.

 Sub CopyDocProps() On Error GoTo ErrorHandler    Dim appWord As Word.Application    Dim strTemplatePath As String    Dim strOriginalDoc As String    Dim strTargetDoc As String    Dim prp As Object    Dim prpsOriginal As Object    Dim prpsTarget As Object    Dim docOriginal As Word.Document    Dim docTarget As Word.Document        Set appWord = GetObject(, "Word.Application")    strTemplatePath =        appWord.Options.DefaultFilePath(wdUserTemplatesPath)        & "\Access Merge\"    Debug.Print "Templates folder: " & strTemplatePath    strOriginalDoc = strTemplatePath & "Test Letter.dot"    strTargetDoc = strTemplatePath & "TW Contact Letter.dot"    Set docOriginal = appWord.Documents.Open(strOriginalDoc)    Set docTarget = appWord.Documents.Open(strTargetDoc)    Set prpsOriginal = docOriginal.CustomDocumentProperties    Set prpsTarget = docTarget.CustomDocumentProperties     On Error Resume Next    For Each prp In prpsOriginal       Debug.Print "Adding " & prp.Name & " to " & strTargetDoc       prpsTarget.Add Name:=prp.Name, LinkToContent:=False,           Value:=prp.Value, Type:=msoPropertyTypeString    Next prp        appWord.Visible = True     ErrorHandlerExit:    Exit Sub ErrorHandler:    If Err = 429 Then       ‘Word is not running; open Word with CreateObject       Set appWord = CreateObject("Word.Application")       Resume Next    Else       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description       Resume ErrorHandlerExit    End If End Sub 

The CopyDocProps procedure uses some properties of the DocProperty object in the Office object model, because these properties allow you to specify the type of doc property you are creating, and (more importantly) these properties are read/write, which is not the case with doc properties in the Word object model. Because of this, you need to set a reference to the Office object library in a database that uses this code.

While running the procedure, you’ll see the doc property names in the Immediate window, and afterward, you can see the new doc properties on the Custom page of the properties sheet in the target document, as shown in Figure 8.20.

click to expand
Figure 8.20

The next step is to make field codes visible on the template (which should be open after running the CopyDocProps procedure), delete the FormText, MailMerge, or other codes, and insert DocProperty codes where you want the data from the name and address doc properties to appear in the document. Figure 8.21 shows the FormText fields in the original TW Contact Letter template being replaced by DocProperty codes.

click to expand
Figure 8.21

Inserting DocProperty fields is a multistep process, and it is different in Word 2000 and Word 2002 (or higher). For a complete explanation of how to insert a DocProperty field in a document, see my white paper “Adding Custom Doc Properties to a Word Template,” which can be downloaded from the Downloads page on my Web site (www.helenfeddema.com).

After inserting DocProperty fields where needed, the next step is to add the template to the tlkpLetters lookup table so that it will be available for the cboLetters combobox on the main menu. Next, the SQL statement in the cboRecipients RowSource property needs to have zstblSampleData replaced by the table you want to use for selecting letter recipients (I’ll use the tblVendors table), and you can modify calculated expressions as needed. I also added the FirstName field to the query, to use for the Salutation doc property. The SQL statement is shown in Figure 8.22.

click to expand
Figure 8.22

If the SQL statement has a different number of columns after your modifications, modify the Columns and ColumnWidths properties of the combobox accordingly (all columns except the first should have a width of zero) because they don’t need to show in the drop-down list).

Finally, the Click event procedure of the cmdLetters command button needs tweaking, to match up the SQL statement fields with the doc properties. The table below shows how the fields match the doc properties (you need to know the zero-based column position to reference the field in VBA code):

Row Source Field

Doc Property

Column Position

LastNameFirst

[not used]

0

Address

Street

1

City

City

2

StateOrProvince

State

3

PostalCode

Zip

4

ContactFirstName

Salutation

5

FirstNameFirst

Name

6

The modified procedure is:

 Private Sub cmdLetters_Click() On Error GoTo ErrorHandler    Dim strLetter As String    Dim strRecipient As String    Dim strTestFile As String    Dim cbo As Access.ComboBox    Dim docs As Word.Documents    Dim prps As Object    Dim strDocsPath As String    Dim strTemplatePath As String        ‘Check that a letter has been selected    strLetter = Nz(Me![cboLetters])    Set cbo = Me![cboLetters]    If strLetter = "" Then       cbo.SetFocus       cbo.Dropdown       GoTo ErrorHandlerExit    End If        ‘Check that a recipient has been selected.    strRecipient = Nz(Me![cboRecipients])    Set cbo = Me![cboRecipients]    If strRecipient = "" Then       cbo.SetFocus       cbo.Dropdown       GoTo ErrorHandlerExit    End If           Set appWord = GetObject(, "Word.Application")    strDocsPath = DocsDir    ‘Reference a subfolder under the Templates folder (optional)    strTemplatePath = TemplateDir & "Access Merge\"    strLetter = strTemplatePath & strLetter        ‘Check for existence of template in template folder,    ‘and exit if not found    strTestFile = Nz(Dir(strLetter))    Debug.Print "Test file: " & strTestFile    If strTestFile = "" Then       MsgBox strLetter & " template not found; can’t create letter"       GoTo ErrorHandlerExit    End If        Set docs = appWord.Documents    docs.Add strLetter    Set cbo = Me![cboRecipients] On Error Resume Next    Set prps = appWord.ActiveDocument.CustomDocumentProperties    prps.Item("Name").Value = Nz(cbo.Column(6))    prps.Item("Street").Value = Nz(cbo.Column(1))    prps.Item("City").Value = Nz(cbo.Column(2))    prps.Item("State").Value = Nz(cbo.Column(3))    prps.Item("Zip").Value = Nz(cbo.Column(4))    prps.Item("Salutation").Value = Nz(cbo.Column(5))     On Error GoTo ErrorHandlerExit    ‘Update fields and make letter visible    With appWord       .Visible = True       .Selection.WholeStory       .Selection.Fields.Update       .Visible = True       .Activate    End With     ErrorHandlerExit:    Exit Sub ErrorHandler:    If Err = 429 Then       ‘Word is not running; open Word with CreateObject.       Set appWord = CreateObject("Word.Application")       Resume Next    Else       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description       Resume ErrorHandlerExit    End If End Sub 

With these changes in place, after selecting the TW Contact Letter template and a recipient, a letter similar to the one in Figure 8.23 is generated.

click to expand
Figure 8.23

You might want to have more choices when creating documents, such as sending letters to everyone or to multiple (but not all) recipients. Or you might want to create a catalog merge, to put data from different records into rows of a Word table. If you have huge numbers of recipients, too many to produce a separate Word letter for each one in a single session, you need to do a mail merge. All these alternate methods of creating Word documents filled with Access data are discussed in detail in Chapter 11, Working with Word.




Expert One-on-One(c) Microsoft Access Application Development
Expert One-on-One Microsoft Access Application Development
ISBN: 0764559044
EAN: 2147483647
Year: 2006
Pages: 124
Authors: Helen Feddema

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