Fine. Here's the code for the relevant procedure:
Private Sub cmdFill_FlatFileTable_Click()
On Error GoTo Err_cmdFill_FlatFileTable_Click
Dim strFlatFile_TableName As String
Dim strMsg As String
Dim strSQL As String
Dim strFilterGroup As String 'if none, then "NONE"
Dim dtFillDateTime As Date
Dim strFillDateTime As String
Dim strFilterGroupAndFillDateTime As String
Dim rsMeta As Recordset 'single-record recordset containing the
individual flat-file metadata
Dim rsInd As Recordset 'the INDIVIDUAL table
Dim res As Integer
Dim varContactsRel As Variant 'the guid corresponding to the "has as a
contact" relationship
Dim varOrganization_ID As Variant
'Initialize dtFillDateTime
dtFillDateTime = #1/1/1900#
'Initialize varOrganization_ID
varOrganization_ID = Null
'Verify that a valid individual flat-file tablename has been chosen. If
not, bail out.
cboFlatFile_TableNames.SetFocus
If Trim$(cboFlatFile_TableNames.Text) = "" Then
strMsg = "You must first select a valid individual flat-file table
name using the drop-down box to the left !"
MsgBox strMsg, vbOKOnly + vbCritical, "Error"
Exit Sub
Else
strFlatFile_TableName = Trim$(CStr(cboFlatFile_TableNames.Text))
End If
'Verify that user wants to go ahead.
strMsg = "You are about to fill the individual flat-file table named '"
& strFlatFile_TableName & "' " & vbCr & vbLf
strMsg = strMsg & "with current data. Any existing data in the table
will be erased."
res = MsgBox(strMsg, vbOKCancel + vbQuestion, "Are you sure?")
If res = vbOK Then 'go ahead
'Call the MS Access form titled "Select Individual Filter Group (If
Necessary)"
'Get the strFilterGroup return value, and close the form.
DoCmd.OpenForm "GetIndGroupName", acNormal, , , , acDialog 'The
acDialog option is REQUIRED in order for GetIndGroupName to behave like a
dialog box.
strFilterGroup = Forms!GetIndGroupName.FilterGroup() 'The
FilterGroup public function is REQUIRED in order to return the strFilterGroup
public variable.
DoCmd.Close acForm, "GetIndGroupName"
If strFilterGroup = "NONE" Then 'NO filtration by group
strMsg = "You are about to fill the individual flatfile table
''" & strFlatFile_TableName & "'' without filtering by group."
res = MsgBox(strMsg, vbOKCancel + vbQuestion, "Are you sure?")
If res = vbCancel Then
strMsg = "The filling of the individual flatfile ''" &
strFlatFile_TableName & "'' has been canceled."
MsgBox strMsg, vbOKOnly, "Note"
Exit Sub
End If
Else 'filtration by group
strMsg = "You are about to fill the individual flatfile table
''" & strFlatFile_TableName & "'', filtering by the individual group ''" &
strFilterGroup & "''."
res = MsgBox(strMsg, vbOKCancel + vbQuestion, "Are you sure?")
If res = vbCancel Then
strMsg = "The filling of the individual flatfile ''" &
strFlatFile_TableName & "'' has been canceled."
MsgBox strMsg, vbOKOnly, "Note"
Exit Sub
End If
End If
'Set mousepointer to the hourglass.
Screen.MousePointer = 11
'Delete all records from the selected individual flat-file table.
strSQL = "DELETE FROM " & strFlatFile_TableName
On Error Resume Next 'in case there are no records in
strFlatFile_TableName
CurrentProject.Connection.Execute strSQL, , adCmdText +
adExecuteNoRecords
'Get the one-record metadata for the selected strFlatFile_TableName.
Set rsMeta = New Recordset
rsMeta.Source = "SELECT * FROM RENAMED_INDIVIDUAL_FLATFILE_METADATA
WHERE TableName ='" & strFlatFile_TableName & "'"
rsMeta.ActiveConnection = CurrentProject.Connection
rsMeta.CursorType = adOpenForwardOnly
rsMeta.LockType = adLockOptimistic 'since we need to write the
columns DateTimeTableFilled and FilterGroupName
rsMeta.CacheSize = 1
rsMeta.Open
rsMeta.MoveFirst
'[Now you can just refer to rsMeta("TableName"),
rsMeta("Individual_ID") etc. to get at the metadata.]
'Open the rsFlatFile recordset to receive data.
Set rsFlatFile = New Recordset
rsFlatFile.Source = "SELECT * FROM " & strFlatFile_TableName
rsFlatFile.ActiveConnection = CurrentProject.Connection
rsFlatFile.CursorType = adOpenForwardOnly
rsFlatFile.LockType = adLockOptimistic
rsFlatFile.CacheSize = 1
rsFlatFile.Open
'Open rsInd to read from the INDIVIDUAL table.
Set rsInd = New Recordset
If strFilterGroup = "NONE" Then 'NO filter by individual group
strSQL = "SELECT * FROM INDIVIDUAL ORDER BY LastName, FirstName,
MiddleName, Suffix"
Else 'filter by individual group
strSQL = "SELECT * FROM INDIVIDUAL WHERE EXISTS "
strSQL = strSQL & "(SELECT * FROM GROUP_MEMBER AS GM WHERE
GM.GroupName = '"
strSQL = strSQL & strFilterGroup & "' AND GM.Individual_ID =
INDIVIDUAL.Individual_ID) "
strSQL = strSQL & "ORDER BY LastName, FirstName, MiddleName,
Suffix"
End If
rsInd.Source = strSQL
rsInd.ActiveConnection = CurrentProject.Connection
rsInd.CursorType = adOpenForwardOnly
rsInd.LockType = adLockReadOnly
rsInd.CacheSize = 1
rsInd.Open
'If no rsInd records, bail out.
If rsInd.RecordCount = 0 Then
If strFilterGroup = "NONE" Then
strMsg = "There are no individual records to fill the
individual flatfile table with."
Else
strMsg = "There are no individual records in the individual
group ''" & strFilterGroup & "'' to fill the individual flatfile table with."
End If
MsgBox strMsg, vbOKOnly + vbCritical, "Stop"
dtFillDateTime = #1/1/1900#
strFilterGroup = "EMPTY"
GoTo Exit_cmdFill_FlatFileTable_Click
End If
'Go through rsInd (INDIVIDUAL), creating the rsFlatFile records as
you go.
rsInd.MoveFirst
Do Until rsInd.EOF
rsFlatFile.AddNew 'create new individual flat-file record
If rsMeta("Individual_ID") = True Then
rsFlatFile("Individual_ID") = rsInd("Individual_ID")
End If
If rsMeta("Salutation") = True Then
rsFlatFile("Salutation") = rsInd("Salutation")
End If
If rsMeta("FirstName") = True Then
rsFlatFile("FirstName") = rsInd("FirstName")
End If
If rsMeta("MiddleName") = True Then
rsFlatFile("MiddleName") = rsInd("MiddleName")
End If
If rsMeta("LastName") = True Then
rsFlatFile("LastName") = rsInd("LastName")
End If
If rsMeta("Suffix") = True Then
rsFlatFile("Suffix") = rsInd("Suffix")
End If
If rsMeta("Nickname") = True Then
rsFlatFile("Nickname") = rsInd("Nickname")
End If
If rsMeta("Title") = True Then
rsFlatFile("Title") = rsInd("Title")
End If
If rsMeta("Gender") = True Then
rsFlatFile("Gender") = rsInd("Gender")
End If
If rsMeta("BirthDate") = True Then
rsFlatFile("BirthDate") = rsInd("BirthDate")
End If
If rsMeta("SocialSecurityNumber") = True Then
rsFlatFile("SocialSecurityNumber") =
rsInd("SocialSecurityNumber")
End If
If rsMeta("IndividualUserID") = True Then
rsFlatFile("IndividualUserID") = rsInd("IndividualUserID")
End If
If rsMeta("SpouseName") = True Then
rsFlatFile("SpouseName") = rsInd("SpouseName")
End If
If rsMeta("ChildrenNames") = True Then
rsFlatFile("ChildrenNames") = rsInd("ChildrenNames")
End If
If rsMeta("Notes") = True Then
rsFlatFile("Notes") = rsInd("Notes")
End If
If rsMeta("PhotoPath") = True Then
rsFlatFile("PhotoPath") = rsInd("PhotoPath")
End If
If rsMeta("UserID") = True Then
rsFlatFile("UserID") = rsInd("UserID")
End If
If rsMeta("DateTimeAdded") = True Then
rsFlatFile("DateTimeAdded") = rsInd("DateTimeAdded")
End If
If rsMeta("QB_Customer_ListID") = True Then
rsFlatFile("QB_Customer_ListID") = rsInd("QB_Customer_ListID")
End If
If rsMeta("QB_Vendor_ListID") = True Then
rsFlatFile("QB_Vendor_ListID") = rsInd("QB_Vendor_ListID")
End If
If rsMeta("QB_Employee_ListID") = True Then
rsFlatFile("QB_Employee_ListID") = rsInd("QB_Employee_ListID")
End If
If rsMeta("QB_Balance") = True Then
rsFlatFile("QB_Balance") = rsInd("QB_Balance")
End If
If rsMeta("Degrees") = True Then
Call Do_Degrees(rsInd("Individual_ID"),
rsMeta("MaxNumDegrees"))
End If
If rsMeta("EmailAddresses") = True Then
Call Do_EmailAddresses(rsInd("Individual_ID"),
rsMeta("MaxNumEmailAddresses"))
End If
If rsMeta("TypeNoneAddresses") = True Then
Call Do_TypeNoneAddresses(rsInd("Individual_ID"),
rsMeta("MaxNumTypeNoneAddresses"))
End If
If rsMeta("BillingAddresses") = True Then
Call Do_BillingAddresses(rsInd("Individual_ID"),
rsMeta("MaxNumBillingAddresses"))
End If
If rsMeta("ShippingAddresses") = True Then
Call Do_ShippingAddresses(rsInd("Individual_ID"),
rsMeta("MaxNumShippingAddresses"))
End If
If rsMeta("FaxPhones") = True Then
Call Do_FaxPhones(rsInd("Individual_ID"),
rsMeta("MaxNumFaxPhones"))
End If
If rsMeta("MobilePhones") = True Then
Call Do_MobilePhones(rsInd("Individual_ID"),
rsMeta("MaxNumMobilePhones"))
End If
If rsMeta("PagerPhones") = True Then
Call Do_PagerPhones(rsInd("Individual_ID"),
rsMeta("MaxNumPagerPhones"))
End If
If rsMeta("TollFreePhones") = True Then
Call Do_TollFreePhones(rsInd("Individual_ID"),
rsMeta("MaxNumPagerPhones"))
End If
If rsMeta("VoicePhones") = True Then
Call Do_VoicePhones(rsInd("Individual_ID"),
rsMeta("MaxNumVoicePhones"))
End If
If rsMeta("Groups") = True Then
Call Do_Groups(rsInd("Individual_ID"), rsMeta("MaxNumGroups"))
End If
If rsMeta("OrganizationName_ContactFor") = True Then
varContactsRel = DGuidLookup("Org2Ind_Rel_ID",
"ORG_TO_IND_RELATIONSHIP", "Org2Ind_Relationship", "has as a contact")
Call Do_OrganizationName(rsInd("Individual_ID"),
varContactsRel, varOrganization_ID)
End If
If rsMeta("OrganizationAddress_ContactFor") = True And Not
IsNull(varOrganization_ID) Then
'START HERE
End If
rsFlatFile.Update 'update new individual flat-file record
rsInd.MoveNext 'move to next INDIVIDUAL record
Loop
'Update dtFillDateTime
dtFillDateTime = Now
'Inform user of success.
MsgBox "The '" & strFlatFile_TableName & "' table has been filled
with current data.", vbOKOnly, "Note"
End If
Exit_cmdFill_FlatFileTable_Click:
'Write the columns DateTimeTableFilled and FilterGroupName
rsMeta("DateTimeTableFilled") = dtFillDateTime
rsMeta("FilterGroupName") = strFilterGroup
rsMeta.Update
'Update label for cboFlatFile_TableNames
'Build strFilterGroupAndFillDateTime
strFillDateTime = CStr(dtFillDateTime)
strFilterGroupAndFillDateTime = "Filter Group = " & strFilterGroup &
vbCrLf & "Fill Date/Time = " & strFillDateTime
'Load the caption.
Me![lblFilterGroupAndFillDateTime].Caption =
strFilterGroupAndFillDateTime
'Close open recordsets, if necessary.
If Not rsMeta Is Nothing Then
If rsMeta.State <> adStateClosed Then
rsMeta.Close
End If
Set rsMeta = Nothing
End If
If Not rsFlatFile Is Nothing Then
If rsFlatFile.State <> adStateClosed Then
rsFlatFile.Close
End If
Set rsFlatFile = Nothing
End If
If Not rsInd Is Nothing Then
If rsInd.State <> adStateClosed Then
rsInd.Close
End If
Set rsInd = Nothing
End If
'Re-set mousepointer to the default.
Screen.MousePointer = 0
'Exit Sub
Exit Sub
Err_cmdFill_FlatFileTable_Click:
MsgBox Err.Description
Resume Exit_cmdFill_FlatFileTable_Click
End Sub