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.
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.
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.
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.
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
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.
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.
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.
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.
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.
Figure 8.17
The update query is shown in Design view in Figure 8.18.
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.
Figure 8.19
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:
Add the required doc properties to the client’s Word template(s).
Add the templates to tlkpLetters.
Replace the sample zstblSampleData table in cboLetter’s RowSource property with a reference to the database table that contains the letter recipient data.
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.
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.
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.
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.
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.