Export nested tables to new back end
<p>I have an Access back end database with 7 nested, related tables: Clients, Projects, Project Goals, Goal Impediments, Impediment Causes, Possible Solutions and Required Actions or Resources. Each client may have multiple Projects. Each Project may have multiple records in Goals to Actions.</p>

<p>I want to export one Client Project with its nested tables into an empty back end with exactly the same structure, so the Client, supplied with front and back end, can review the information and make changes. If the client has made changes, I want to import the changes back into the master database, replacing the existing data.</p>

<p>Clients has the usual personal information. Projects has eight fields including a linked ID to Clients. Each Table from Goals to Actions has an Auto numbered primary key, an ID field linked to the primary key of table above, a 100 character short description, a long field for Notes, a number for priority or weighted importance and a Yes/No field for Resolved or Completed. Each may have between 1 and 10 records. There are 94 records in the sample record set I am working with.</p>

<p>It is easy enough to extract the Project and its related data from the database with a query; but I am having trouble coming up with the most efficient way to insert it into the empty back end. I started a few subroutines under an Export button to transfer the data table by table, so I could handle the changed relationships caused by the renumbered the primary keys; but I would like to do the entire process in one fell swoop, if possible. I created a huge back end file with one flawed attempt at a While NOT rsSource.EOF – Wend routine. Any suggestions gratefully received.</p>

<p>******************************** Code **********************************</p>

<pre><code>Private Sub Command316_Click()
' SelectedClient and SelectedProject are Public Integer variables
' To be used in For...Next loops
Dim i, iNumRecs, intGoal, intImped, intCause, intSolution, intAction As Integer
Dim SQLstr As String

'Open source database
Dim dbSource As Database
Set dbSource = CurrentDb

'Open dest database
Dim dbDestination As Database
Set dbDestination = DAO.OpenDatabase("C:\Prosolve\Temp\Prosolve_BE.accdb")

' Select Project to be transferred
' Might be easier to work with if everything NOT selected at once

SQLstr = "SELECT Clients.ClientID, Clients.ContactFirstName, Clients.ContactLastName, Clients.Address, Clients.City, Clients.StateOrProvince, Clients.PostalCode, "
SQLstr = SQLstr + "Clients.Country, Clients.EmailAddress, Clients.CompanyName, Clients.PhoneNumber, Clients.CellNumber, Clients.BillingRate, Clients.TaxPayable, Clients.Discount, "
SQLstr = SQLstr + "Projects.ProjectID, Projects.ClientID, Projects.ProjectName, Projects.ProjectOwner, Projects.ProjectDescription, Projects.EmployeeID, Projects.Priority, Projects.TotalBilled, "
SQLstr = SQLstr + "Goals.GoalID, Goals.ProjectID, Goals.Goal, Goals.Notes, Goals.Owners, Goals.Gpriority, "
SQLstr = SQLstr + "Impediments.ImpedID, Impediments.IgoalID, Impediments.Impediment, Impediments.Notes, Impediments.Iweight, Impediments.Resolved, "
SQLstr = SQLstr + "Causes.CauseID, Causes.cimpedID, Causes.cause, Causes.Notes, Causes.cweight, Causes.resolved, "
SQLstr = SQLstr + "Solutions.SolutionID, Solutions.ScauseID, Solutions.Solution, Solutions.Notes, Solutions.Sweight, Solutions.Implemented, "
SQLstr = SQLstr + "Actions.ActionID, Actions.AsolutionID, Actions.Action, Actions.Notes, Actions.Priority, Actions.Completed "
SQLstr = SQLstr + "FROM ((Clients INNER JOIN Projects ON Clients.ClientID = Projects.ClientID) "
SQLstr = SQLstr + "INNER JOIN ((Goals INNER JOIN Impediments ON Goals.GoalID = Impediments.IgoalID) "
SQLstr = SQLstr + "INNER JOIN (Causes INNER JOIN Solutions ON Causes.causeID = Solutions.ScauseID) "
SQLstr = SQLstr + "ON Impediments.ImpedID = Causes.cimpedID) ON Projects.ProjectID = Goals.ProjectID) "
SQLstr = SQLstr + "INNER JOIN Actions ON Solutions.SolutionID = Actions.AsolutionID "
SQLstr = SQLstr + "WHERE Clients.ClientID = " &amp; SelectedClient &amp; " AND Projects.ProjectID = " &amp; SelectedProject &amp; " ;"


'Open source recordset
Dim rsSource As Recordset
Set rsSource = dbSource.OpenRecordset(SQLstr, dbOpenDynaset)

'Open dest recordset
Dim rsDestination As Recordset
Set rsDestination = dbDestination.OpenRecordset("Clients", dbOpenDynaset)

'Loop through source recordset
'While Not rsSource.EOF

    'Look for record in dest recordset
    rsDestination.FindFirst "ContactFirstName = '" &amp; rsSource.Fields("ContactFirstName") &amp; "'"
    '&amp; " AND ContactLastName = " &amp; rsSource.Fields("ContactLastName") &amp; ""

    'If not found, copy record
    'Works okay
    If rsDestination.NoMatch Then
        rsDestination.AddNew
        rsDestination.Fields("ContactFirstName") = rsSource.Fields("ContactFirstName")
        rsDestination.Fields("ContactLastName") = rsSource.Fields("ContactLastName")
        rsDestination.Fields("Address") = rsSource.Fields("Address")
        rsDestination.Fields("City") = rsSource.Fields("City")
        rsDestination.Fields("StateOrProvince") = rsSource.Fields("StateOrProvince")
        rsDestination.Fields("PostalCode") = rsSource.Fields("PostalCode")
        rsDestination.Fields("Country") = rsSource.Fields("Country")
        rsDestination.Fields("EmailAddress") = rsSource.Fields("EmailAddress")
        rsDestination.Fields("CompanyName") = rsSource.Fields("CompanyName")
        rsDestination.Fields("PhoneNumber") = rsSource.Fields("PhoneNumber")
        rsDestination.Fields("CellNumber") = rsSource.Fields("CellNumber")
        rsDestination.Fields("BillingRate") = rsSource.Fields("BillingRate")
        rsDestination.Fields("TaxPayable") = rsSource.Fields("TaxPayable")
        rsDestination.Fields("Discount") = rsSource.Fields("Discount")
        rsDestination.Update
    Else
    MsgBox "Record alreasy exists"
    End If
'Works okay
Set rsDestination = dbDestination.OpenRecordset("Projects", dbOpenDynaset)
    rsDestination.FindFirst "ClientID = 1"
    If rsDestination.NoMatch Then
        rsDestination.AddNew
        rsDestination.Fields("ClientID") = 1
        rsDestination.Fields("ProjectName") = rsSource.Fields("ProjectName")
        rsDestination.Fields("ProjectOwner") = rsSource.Fields("ProjectOwner")
        rsDestination.Fields("ProjectDescription") = rsSource.Fields("ProjectDescription")
        rsDestination.Fields("EmployeeID") = rsSource.Fields("EmployeeID")
        rsDestination.Fields("Priority") = rsSource.Fields("Projects.Priority")
        rsDestination.Fields("TotalBilled") = rsSource.Fields("TotalBilled")
        rsDestination.Update
    Else
    MsgBox "Record alreasy exists"
    End If

' Try to find number of Goals for a For ... Next procedure
' Not counting Goals in Query. Will cause problems later when 2 or more client have same ProjectID
iNumRecs = DCount("ProjectID", "Goals", "ProjectID = " &amp; SelectedProject &amp; "")

'Here we need to copy all goals for projectID = 1 from 1 to number of goals'
' Once this is done successfully the process can be repeated for tables below it
'Loop through source recordset
'Currently copies 6 x first goal. rsSource.Movenext not working.
Set rsDestination = dbDestination.OpenRecordset("Goals", dbOpenDynaset)
    rsDestination.FindFirst "ProjectID = " &amp; SelectedProject &amp; ""
    If rsDestination.NoMatch Then
    For i = 1 To iNumRecs
        rsDestination.AddNew
        rsDestination.Fields("ProjectID") = SelectedProject
        rsDestination.Fields("Goal") = rsSource.Fields("Goal")
        rsDestination.Fields("Notes") = rsSource.Fields("Goals.Notes")
        rsDestination.Fields("Owners") = rsSource.Fields("Owners")
        rsDestination.Fields("Gpriority") = rsSource.Fields("Gpriority")
        rsDestination.Update
        rsSource.MoveNext
    Next
    Else
    MsgBox "Record alreasy exists"
    End If


MsgBox "Procedure successfully completed to this point"

End Sub
</code></pre>

<p>******************************** End Code **********************************</p>