Using VBA Code to Move Data from a Non-Normalized Table to Linked Normalized Tables

The next task in moving data from tblRawCustomers involves the three sets of fields that don’t belong in tblCustomers, but need to be appended to the three linked tables (tblCustomerPhones, tblCustomerEMails, and tblShippingAddresses). When the records were appended from tblRawCustomers to tblCustomers, new CustomerIDs were created for the records, and the CustomerID is needed to link these new records to their matching new records in the linked tables. This means that the new CustomerID needs to be written back to the CustomerID field in tblRawCustomers. tblRawCustomers has 500 records, while the original tblCustomers had 69 records, and now has 569 records. So the last 500 records of tblCustomers are the ones whose CustomerIDs (numbering 70 to 569) need to be written to the corresponding records in tblRawCustomers.

To do the updating, first create a select query based on tblCustomers, with the criterion >69 and an ascending sort on its CustomerID field, and save it as qryNewCustomers. Figure 10.17 shows this query in Design view.

Figure 10.17

Next (just to make absolutely sure that the records are sorted by CustomerID), make a select query based on tblRawCustomers, sorted ascending by CustomerID, and save it as qryRawCustomers. Now there are two queries, each with 500 records, sorted by CustomerID, with matching records, as shown in Figure 10.18.

Figure 10.18

To write the new CustomerID values to tblRawCustomers, I set up two DAO recordsets and iterated through them record by record, writing the value from the recordset based on qryNewCustomers to the recordset based on qryRawCustomers. The code goes to the first record of rstOld, and then loops through rstNew, using the CStr function to convert the numeric CustomerID in rstNew to a string that is saved to the record in rstOld. The modified record in rstOld is updated, and the code moves to the next record in both recordsets. This procedure is:

 Public Sub NewCustomerIDs() On Error GoTo ErrorHandler        Dim rstOld As DAO.Recordset    Dim rstNew As DAO.Recordset        Set dbs = CurrentDb    Set rstOld = dbs.OpenRecordset("qryRawCustomers")    Set rstNew = dbs.OpenRecordset("qryNewCustomers")    rstOld.MoveFirst    Do While Not rstNew.EOF       rstOld.Edit       rstOld![CustomerID] = CStr(rstNew![CustomerID])       rstOld.Update       rstOld.MoveNext       rstNew.MoveNext    Loop     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

You can run a Sub procedure by calling it from code in another procedure or by pressing the F5 hot key with the cursor inside the procedure. Subs can’t be run from macros, but If you need to run code from a macro, you can just convert the Sub procedure to a function with no return value, and call it from a RunCode action in a macro.

Now the matching records in tblRawCustomers and tblCustomers have the same CustomerID, as shown in Figure 10.19.

Figure 10.19

Since CustomerID is a text field in tblRawCustomers (and thus is sorted alphabetically), the first group of new fields (numbered 70 to 99) is at the end of the table.

The next step is to write procedures for adding records to the linked tables, using the new, correct CustomerIDs as the foreign keys. But first, I’ll create concatenated fields in qryRawCustomers, to combine the two street address fields into one for the first and second shipping addresses. These fields are similar to the ones for the main address fields, but with the appropriate field names replaced. The two concatenated fields follow, and they are shown in Datasheet view in Figure 10.20.

ShippingAddress1: IIf(Nz([ShippingAddressStreet2])<>””,[ShippingAddressStreet]  & Chr(13) & Chr(10) & [ShippingAddressStreet2],[ShippingAddressStreet]) ShippingAddress2: IIf(Nz([Shipping2AddressStreet2])<>””,[Shipping2AddressStreet] & Chr(13)  & Chr(10) & [Shipping2AddressStreet2],[Shipping2AddressStreet])

Figure 10.20

The procedure that creates new records in tblCustomerPhones is listed below. The procedure sets up recordsets based on qryRawCustomers and tblCustomerPhones, and loops through the records in qryRawCustomers. The code checks each phone number field, and if it has a phone number, then the code creates a new record in tblCustomerPhones, writing the CustomerID, phone number, and phone description to the new record.

 Public Sub NewCustomerPhones() On Error GoTo ErrorHandler        Dim rstCustomers As DAO.Recordset    Dim rstPhones As DAO.Recordset    Dim lngCustomerID As Long        Set dbs = CurrentDb    Set rstCustomers = dbs.OpenRecordset("qryRawCustomers")    Set rstPhones = dbs.OpenRecordset("tblCustomerPhones")    Do While Not rstCustomers.EOF       ‘Pick up CustomerID from tblRawCustomers       lngCustomerID = CLng(rstCustomers![CustomerID])       ‘For each phone number field with a value, add a record       ‘to tblCustomerPhones for this CustomerID.       If Nz(rstCustomers![Fax]) <> "" Then          rstPhones.AddNew          rstPhones![CustomerID] = lngCustomerID          rstPhones![PhoneDescription] = "Fax"          rstPhones![PhoneNumber] = rstCustomers![Fax]          rstPhones.Update End If       If Nz(rstCustomers![Phone1]) <> "" Then          rstPhones.AddNew          rstPhones![CustomerID] = lngCustomerID          rstPhones![PhoneDescription] = "Phone 1"          rstPhones![PhoneNumber] = rstCustomers![Phone1]          rstPhones.Update       End If       If Nz(rstCustomers![Phone2]) <> "" Then          rstPhones.AddNew          rstPhones![CustomerID] = lngCustomerID          rstPhones![PhoneDescription] = "Phone 2"          rstPhones![PhoneNumber] = rstCustomers![Phone2]          rstPhones.Update       End If       If Nz(rstCustomers![CallbackPhone]) <> "" Then          Debug.Print "Callback number: " & rstCustomers![CallbackPhone]          rstPhones.AddNew          rstPhones![CustomerID] = lngCustomerID          rstPhones![PhoneDescription] = "Callback Phone"          rstPhones![PhoneNumber] = rstCustomers![CallbackPhone]          rstPhones.Update       End If       If Nz(rstCustomers![CarPhone]) <> "" Then          rstPhones.AddNew          rstPhones![CustomerID] = lngCustomerID          rstPhones![PhoneDescription] = "Car Phone"          rstPhones![PhoneNumber] = rstCustomers![CarPhone]          rstPhones.Update       End If       If Nz(rstCustomers![CellPhone]) <> "" Then          rstPhones.AddNew          rstPhones![CustomerID] = lngCustomerID          rstPhones![PhoneDescription] = "Cell Phone"          rstPhones![PhoneNumber] = rstCustomers![CellPhone]          rstPhones.Update       End If       If Nz(rstCustomers![Pager]) <> "" Then          rstPhones.AddNew          rstPhones![CustomerID] = lngCustomerID          rstPhones![PhoneDescription] = "Pager"          rstPhones![PhoneNumber] = rstCustomers![Pager]          rstPhones.Update       End If       rstCustomers.MoveNext    Loop     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

Access sometimes copies links when you make a copy of a table, which can lead to problems in code or queries. If you see an error message like the one in Figure 10.21 when running this procedure (or any procedure), you need to put the offending table (usually a table that was copied from another table) into the Relationships diagram and delete any links to it.

Figure 10.21

Figure 10.22 shows tblCustomerPhones with some of the phone numbers added by the NewCustomerPhones procedure.

Figure 10.22

The next procedure adds email addresses to tblCustomerEMails in a similar manner:

 Public Sub NewCustomerEMails() On Error GoTo ErrorHandler        Dim rstCustomers As DAO.Recordset    Dim rstEMails As DAO.Recordset    Dim lngCustomerID As Long        Set dbs = CurrentDb    Set rstCustomers = dbs.OpenRecordset("qryRawCustomers")    Set rstEMails = dbs.OpenRecordset("tblCustomerEmails")    Do While Not rstCustomers.EOF       ‘Pick up CustomerID from tblRawCustomers       lngCustomerID = CLng(rstCustomers![CustomerID])       ‘For each email field with a value, add a record       ‘to tblCustomerEMails for this CustomerID       If Nz(rstCustomers![EMail1]) <> "" Then          rstEMails.AddNew          rstEMails![CustomerID] = lngCustomerID          rstEMails![CustomerEMail] = rstCustomers![EMail1]          rstEMails.Update       End If       If Nz(rstCustomers![EMail2]) <> "" Then          rstEMails.AddNew          rstEMails![CustomerID] = lngCustomerID          rstEMails![CustomerEMail] = rstCustomers![EMail2]          rstEMails.Update       End If       If Nz(rstCustomers![EMail3]) <> "" Then          rstEMails.AddNew          rstEMails![CustomerID] = lngCustomerID          rstEMails![CustomerEMail] = rstCustomers![EMail3]          rstEMails.Update       End If       rstCustomers.MoveNext    Loop     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

Figure 10.23 shows some of the email addresses added to tblCustomerEMails by the NewCustomerEMails procedure.

Figure 10.23

The final procedure creates new shipping address records in tblShippingAddresses; it is:

 Public Sub NewCustomerShippingAddresses() On Error GoTo ErrorHandler        Dim rstCustomers As DAO.Recordset    Dim rstShippingAddresses As DAO.Recordset    Dim lngCustomerID As Long        Set dbs = CurrentDb    Set rstCustomers = dbs.OpenRecordset("qryRawCustomers")    Set rstShippingAddresses = dbs.OpenRecordset("tblShippingAddresses")    Do While Not rstCustomers.EOF       ‘Pick up CustomerID from tblRawCustomers       lngCustomerID = CLng(rstCustomers![CustomerID])       ‘For each set of shipping address fields with values, add a record       ‘to tblShippingAddresses for this CustomerID.       If Nz(rstCustomers![ShippingAddress1]) <> "" And           Nz(rstCustomers![ShippingAddressCity]) <> "" And           Nz(rstCustomers![ShippingAddressState]) <> "" And           Nz(rstCustomers![ShippingAddressPostalCode]) <> "" Then          rstShippingAddresses.AddNew          rstShippingAddresses![CustomerID] = lngCustomerID          rstShippingAddresses![AddressIdentifier] = "Shipping Address 1"          rstShippingAddresses![ShipName] = rstCustomers![CustomerName]          rstShippingAddresses![ShipAddress] =              rstCustomers![ShippingAddress1]          rstShippingAddresses![ShipCity] =              rstCustomers![ShippingAddressCity]          rstShippingAddresses![ShipStateOrProvince] =              rstCustomers![ShippingAddressState]          rstShippingAddresses![ShipPostalCode] =              rstCustomers![ShippingAddressPostalCode]          rstShippingAddresses.Update       End If       If Nz(rstCustomers![ShippingAddress2]) <> "" And           Nz(rstCustomers![Shipping2AddressCity]) <> "" And           Nz(rstCustomers![Shipping2AddressState]) <> "" And           Nz(rstCustomers![Shipping2AddressPostalCode]) <> "" Then          rstShippingAddresses.AddNew          rstShippingAddresses![CustomerID] = lngCustomerID          rstShippingAddresses![AddressIdentifier] = "Shipping Address 2"          rstShippingAddresses![ShipName] =              rstCustomers![CustomerName]          rstShippingAddresses![ShipAddress] =              rstCustomers![ShippingAddress2]          rstShippingAddresses![ShipCity] =              rstCustomers![Shipping2AddressCity]          rstShippingAddresses![ShipStateOrProvince] =              rstCustomers![Shipping2AddressState]          rstShippingAddresses![ShipPostalCode] =              rstCustomers![Shipping2AddressPostalCode]          rstShippingAddresses.Update       End If       rstCustomers.MoveNext    Loop     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

There was an error (shown in Figure 10.24) when running the NewCustomerShippingAddresses procedure.

Figure 10.24

I examined the data in tblRawCustomers and saw that one record did not have a value in this field. There should be a value in this field, but if there isn’t, the best way to work around the problem is just to skip saving that record to tblShippingAddresses. I modified the If . . . Then clause that checks each shipping address to only process an address if there is data in the address, city, state, and postal code fields.

If you have a problem while running a procedure to add records to a linked table, you can just delete the records that the procedure added to the linked table before it stopped with the error, and run the procedure again after fixing any problems.

After making this change, the procedure completed without errors. The modified procedure is:

 Public Sub NewCustomerShippingAddresses() On Error GoTo ErrorHandler        Dim rstCustomers As DAO.Recordset    Dim rstShippingAddresses As DAO.Recordset    Dim lngCustomerID As Long        Set dbs = CurrentDb    Set rstCustomers = dbs.OpenRecordset("qryRawCustomers")    Set rstShippingAddresses = dbs.OpenRecordset("tblShippingAddresses")    Do While Not rstCustomers.EOF       ‘Pick up CustomerID from tblRawCustomers       lngCustomerID = CLng(rstCustomers![CustomerID])       ‘For each set of shipping address fields with values, add a record       ‘to tblShippingAddresses for this CustomerID.       If Nz(rstCustomers![ShippingAddress1]) <> "" And           Nz(rstCustomers![ShippingAddressCity]) <> "" And           Nz(rstCustomers![ShippingAddressState]) <> "" And           Nz(rstCustomers![ShippingAddressPostalCode]) <> "" Then          rstShippingAddresses.AddNew          rstShippingAddresses![CustomerID] = lngCustomerID          rstShippingAddresses![AddressIdentifier] = "Shipping Address 1"          rstShippingAddresses![ShipName] = rstCustomers![CustomerName]          rstShippingAddresses![ShipAddress] = rstCustomers![ShippingAddress1]          rstShippingAddresses![ShipCity] = rstCustomers![ShippingAddressCity]          rstShippingAddresses![ShipStateOrProvince] = rstCustomers![ShippingAddressState]          rstShippingAddresses![ShipPostalCode] = rstCustomers![ShippingAddressPostalCode]          rstShippingAddresses.Update       End If       If Nz(rstCustomers![ShippingAddress2]) <> "" And           Nz(rstCustomers![Shipping2AddressCity]) <> "" And           Nz(rstCustomers![Shipping2AddressState]) <> "" And           Nz(rstCustomers![Shipping2AddressPostalCode]) <> "" Then          rstShippingAddresses.AddNew          rstShippingAddresses![CustomerID] = lngCustomerID          rstShippingAddresses![AddressIdentifier] = "Shipping Address 2"          rstShippingAddresses![ShipName] = rstCustomers![CustomerName]          rstShippingAddresses![ShipAddress] = rstCustomers![ShippingAddress2]          rstShippingAddresses![ShipCity] = rstCustomers![Shipping2AddressCity]          rstShippingAddresses![ShipStateOrProvince] = rstCustomers![Shipping2AddressState]          rstShippingAddresses![ShipPostalCode] = rstCustomers![Shipping2AddressPostalCode]          rstShippingAddresses.Update       End If       rstCustomers.MoveNext    Loop     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

Figure 10.25 shows tblShippingAddresses with some of the new shipping addresses appended by the NewCustomerShippingAddresses procedure.

Figure 10.25