Create Dynamic SQL Statements Using VBA
One of the more syntactically tricky procedures in VBA is to create a SQL statement using a combination of table or query elements along with dynamic variables. SQL statements are created for many uses, but two of the more common reasons are:
(1) Updating a Recordsource property for a combo
box or other control
(2) Creating a SQL query for a record set
Three examples in the code below illustrate the VBA syntax to create a SQL statement. In these examples, I put the actual translated SQL statement in comments immediately below the SQL statement to show how they are actually rendered to the Jet Engine. Notice the use of the double-quote characters. The code below consists of "snippets" of a larger program and all the variables are not defined, since some of them are in the Global area of the program and others are form objects.
Program Code
Option Compare Database
Option Explicit
Option Base 1
' ******************************************************************
' Example 1 - The Row Source Is Dynamically Changed on the Combo Box
' "Enter Event" using a Predefined Query in the
' SQL Statement
' ******************************************************************
Private Sub cmbComboBox_Enter()
' ******************************************************************
' When The Combo Box Is Entered, Set Up Values to Be Displayed
' ******************************************************************
cmbComboBox.RowSource = _
"SELECT qryStylesForDropDownBox.Style FROM qryStylesForDropDownBox ORDER BY [Style];"
End Sub
' ******************************************************************
' Example 2 - Row Source Is Dynamically Changed on the Combo Box
' Enter Event Using A Code-Created SQL Query --
' Note How The """" Translates to One " in the Resulting
' SQL Statement
' ******************************************************************
Private Sub cmbDefectCategory_Change()
strDefectCategory = cmbDefectCategory.Value
cmbSubCategory.RowSource = _
"SELECT tblDefectSubCategory.DefectSubCategory, tblDefectSubCategory.SubCategoryDescription" _
& " FROM tblDefectSubCategory WHERE tblDefectSubCategory.DefectCategory = " _
& """" & strDefectCategory & """" & " ORDER BY tblDefectSubCategory.SubCategoryDescription;"
' ******************************************************************
' The Above Statemnt Is Translated To the Following SQL Statement
' Given that strDefectCategory = "E"
' ******************************************************************
'SELECT tblDefectSubCategory.DefectSubCategory, tblDefectSubCategory.SubCategoryDescription
'FROM tblDefectSubCategory
'WHERE tblDefectSubCategory.DefectCategory = "E"
'ORDER BY tblDefectSubCategory.SubCategoryDescription;
End Sub
' ******************************************************************
' Example 3 - A Dynamic SQL Statement Is Created For A Query
' Recordset. Again, Note the Use of """"
' ******************************************************************
Private Sub cmdSelectDefectCode_Click()
Dim db As Database
Dim recIn As Recordset
Dim strSQL As String
intDefectCode = lstDefectDescriptions.Value
strSQL = _
"SELECT tblDefectCodes.DefectDescription FROM tblDefectCodes " & _
"WHERE (tblDefectCodes.DefectCode=" & intDefectCode & _
" AND tblDefectCodes.DefectCategory=" & """" & strDefectCategory & """" & ");"
' ******************************************************************
' The Above Statemnt Create The Following SQL String
' Given That intDefectCode = 2 and strDefectCategory = "E"
' ******************************************************************
'SELECT tblDefectCodes.DefectDescription
'FROM tblDefectCodes
'WHERE (tblDefectCodes.DefectCode=2 AND tblDefectCodes.DefectCategory="E");
Set db = CurrentDb()
Set recIn = db.OpenRecordset(strSQL)
If recIn.EOF Then
strDefectDescription = "No Matching Description Found"
Exit Sub
End If
strDefectDescription = recIn!DefectDescription
recIn.Close
db.Close
Set recIn = Nothing
Set db = Nothing
On Error GoTo Err_cmdCloseForm_Click
DoCmd.Close
Exit_cmdCloseForm_Click:
Exit Sub
Err_cmdCloseForm_Click:
MsgBox Err.Description
Resume Exit_cmdCloseForm_Click
End Sub
Examples Of SQL Statements For Querydefs
' ************************************************************************************************* ' This will show matching, records in table 1 not in table 2, and records in table 2 not in table 2. ' Sample of UNION Functionality ' ************************************************************************************************* SELECT Table1.ID, Table1.Date, Table1.Code, "Equal" AS Equal FROM Table1 INNER JOIN Table2 ON (Table1.Date = Table2.Date) AND (Table1.ID = Table2.ID) UNION SELECT Table1.ID, Table1.Date, Table1.Code, "Table1Only" AS Table1Only FROM Table1 LEFT JOIN Table2 ON (Table1.ID = Table2.ID) AND (Table1.Date = Table2.Date) WHERE (((Table2.Code) Is Null)) UNION SELECT Table2.ID, Table2.Date, Table2.Code, "Table2Only" AS Table2Only FROM Table1 RIGHT JOIN Table2 ON (Table1.Date = Table2.Date) AND (Table1.ID = Table2.ID) WHERE (((Table1.Code) Is Null)); ' ************************************************************************************************* ' Sample Of Select Within Select ' ************************************************************************************************* SELECT User, UserCount FROM (SELECT Table1.USER_NBR As User, Count(Table1.USER_CODE) AS UserCount FROM Table1 GROUP BY Table1.USER_NBR HAVING (Count(Table1.USER_CODE))=1) As A INNER JOIN Table1 ON A.User = Table1.USER_NBR WHERE (((Table1.USER_CODE)="00000"));
Examples of SQL Action and Select Queries not in QueryDefs
Option Compare Database
Option Explicit
' ******************************************************************
' These Variables Are Shared By All Procedures in This Form
' ******************************************************************
Dim varSelectedClientID As Variant
Dim lngClientIDToBePurged As Long
Dim strClientNameToPurge As String
Dim lngResponse As Long
Dim lngCurrentClientTransID As Long
Dim strSQLListEmployees As String
Dim db As DAO.Database
Dim recIn As DAO.Recordset
' ******************************************************************
' EEID Variables
' ******************************************************************
Dim lngEEIDKeyValues() As Long
Dim lngEEIDCount As Long
Dim lngEEIDTableIndex As Long
Dim lngEEIDKeyIndex As Long
Dim strSQL_EEIDRemoval As String
Dim strEEIDTablesToPurge(1 To 32) As String
' ******************************************************************
' Person Variables
' ******************************************************************
Dim lngPersonKeyValues() As Long
Dim varPersonID As Variant
Dim lngPersonCount As Long
Dim lngPersonIndex As Long
Dim lngPersonIDKeyIndex As Long
Dim varEEID As Variant
Dim strSQLDeletePersonData As String
' ******************************************************************
' ClientPlanID Variables
' ******************************************************************
Dim lngClientPlanIDKeyValues()
Dim lngClientPlanCount As Long
Dim strSQLExtractClientPlanIDs As String
Dim strSQLClientPlanIDRemoval As String
Dim strClientPlanTablesToPurge(1 To 3) As String
Dim lngClientPlanTableIndex As Long
Dim lngClientPlanKeyIndex As Long
' ******************************************************************
' PlanID Variables
' ******************************************************************
Dim lngPlanIDKeyValues()
Dim lngPlanCount As Long
Dim strSQLExtractPlanIDs As String
Dim strSQLPlanIDRemoval As String
Dim lngPlanIDIndex As Long
Dim strPlanTables(1 To 3) As String
Dim lngPlanTableIndex As Long
Dim varPlanID As Variant
' ******************************************************************
' TrustID Variables
' ******************************************************************
Dim lngTrustIDKeyValues()
Dim lngTrustCount As Long
Dim strSQLExtractTrustIDs As String
Dim strSQLTrustIDRemoval As String
Dim lngTrustIDIndex As Long
Dim strTrustTables(1 To 2)
Dim lngTrustTableIndex As Long
' ******************************************************************
' ClientTransID Variables
' ******************************************************************
Dim lngClientTransIDTableIndex As Long
Dim strSQL_ClientTransIDRemoval As String
Dim strSQL_ClientData_ClientTransIDRemoval As String
Dim varClientTransID As Variant
' ******************************************************************
' This Array Stores The Name of the Client Tables Which Contain
' The ClientTransID To Be Purged
' The first dimension is the table name
' The second dimension is what the table calls the ClientTransID
' ******************************************************************
Dim strClientIDTablesToPurge(1 To 40, 1 To 2) As String
' ******************************************************************
' Working Tables To Clear
' ******************************************************************
Dim strWorkingTableName(1 To 12) As String
Dim lngWorkingTableNameIndex As Long
Dim strSQLDeleteWorkingTableRows As String
' ******************************************************************
' Error Handler Variables
' ******************************************************************
Dim strProcName As String
Dim strErrorDescription As String
Dim lngErrNumber As Long
Private Sub cmdClearAllSelection_Click()
Call ClearAll
End Sub
Private Sub cmdSelectAll_Click()
Call SelectAll
End Sub
Private Sub cmdRemoveClientData_Click()
On Error GoTo ErrorHandler
DoCmd.Hourglass True
' ******************************************************************
' Initialize Variables And Arrays
' ******************************************************************
Set db = CurrentDb()
Call LoadEEIDTableNames
Call LoadClientIDTableNames
Call LoadClientPlanTableNames
Call LoadPlanTableNames
Call LoadTrustTableNames
Call LoadWorkingTableNames
' ******************************************************************
' Determine if All or Selected Purge Was Requested
' ******************************************************************
If Me.frameSelectOptions = 2 Then
lngResponse = MsgBox("WARNING!!! Are You Sure You Want To Remove All Client Data?", vbYesNo)
If lngResponse = vbNo Then
MsgBox ("Client Data Not Removed")
DoCmd.Hourglass False
Exit Sub
End If
Call SelectAll
End If
' ******************************************************************
' Loop Through Purge Selections
' ******************************************************************
If Me.lstClientsSelected.ItemsSelected.count = 0 Then
MsgBox ("You Must Select At Least 1 Client To Be Removed")
DoCmd.Hourglass False
Exit Sub
End If
With Me.lstClientsSelected
For Each varSelectedClientID In .ItemsSelected
If Not IsNull(varSelectedClientID) Then
lngClientIDToBePurged = .ItemData(varSelectedClientID)
lngResponse = MsgBox("Are You Sure You Want To Remove " & _
Me.lstClientsSelected.Column(0, varSelectedClientID) & "?", vbYesNo)
If lngResponse = vbYes Then
' ******************************************************************
' Step 1: Build The EEID Array
' ******************************************************************
Call BuildEEIDArray
If lngEEIDCount > 0 Then
' ******************************************************************
' Step 1A: Extract PersonIDs From EmployeeData
' ******************************************************************
Call BuildPersonArray
' ******************************************************************
' Step 2: Delete Records Matching To EEIDs from Step 1
' ******************************************************************
Call RemoveEEIDClientRecords
' ******************************************************************
' Step 2A: Remove Records Matching to PersonIDs From Step 1A
' ******************************************************************
Call RemoveRecordsFromPersonTable
End If
' ******************************************************************
' Step 3: Extract ClientPlanIDs
' ******************************************************************
Call BuildClientPlanIDArray
If lngClientPlanCount <> 0 Then
' ******************************************************************
' Step 4: Remove Records Matching to ClientPlanIDs from Step 3
' ******************************************************************
Call RemoveRecordsFromClientPlanTables
End If
' ******************************************************************
' Step 5: Extract Unique PlanIDs from Table ClientData
' ******************************************************************
Call BuildPlanIDArray
' ******************************************************************
' Step 6: Extract Unique TrustIDs from Table Plans
' For Matching PlanIDs from Step 5
' ******************************************************************
Call BuildTrustIDArray
' ******************************************************************
' Step 7: Remove ClientTrustID Matches from many tables
' ******************************************************************
RemoveClientTransIDRecords
' ******************************************************************
' Step 7A: Remove ClientTrustID Matches From ClientData Table
' ******************************************************************
RemoveClientDataClientTransID
' ******************************************************************
' Step 8: Conditionally Remove PlanIDs From Multiple Tables
' ******************************************************************
RemovePlanIDs
' ******************************************************************
' Step 9: Conditionally Remove TrustIDs From Multiple Tables
' ******************************************************************
RemoveTrustIDs
' ******************************************************************
' Step 10: Clear Working Tables
' ******************************************************************
RemoveWorkingTableRecords
End If
End If
Next
End With
MsgBox ("Record Removal Complete")
DoCmd.Hourglass False
DoCmd.Close
Exit Sub
' ******************************************************************
' Error Handler For The Main Procedure
' ******************************************************************
ErrorHandler:
strProcName = "cmdRemoveClientData_Click"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub ClearAll()
' ******************************************************************
' Clear All Selections In The List Box
' ******************************************************************
Dim varClientID As Variant
For Each varClientID In Me.lstClientsSelected.ItemsSelected
Me.lstClientsSelected.Selected(varClientID) = False
Next
End Sub
Private Sub SelectAll()
' ******************************************************************
' Select All Rows in the List Box
' ******************************************************************
Dim lngRow As Long
For lngRow = 0 To Me.lstClientsSelected.ListCount - 1
Me.lstClientsSelected.Selected(lngRow) = True
Next
End Sub
Private Sub LoadEEIDTableNames()
' ******************************************************************
' Load The Table Names for EEID Record Removals
' ******************************************************************
strEEIDTablesToPurge(1) = "DeletedEE_ACAEvents"
strEEIDTablesToPurge(2) = "Distributions2000"
strEEIDTablesToPurge(3) = "EE_ACACoverageStatus"
strEEIDTablesToPurge(4) = "EE_ACACoverageStatusHistory"
strEEIDTablesToPurge(5) = "EE_ACAEvents"
strEEIDTablesToPurge(6) = "EEACABenefitSelection"
strEEIDTablesToPurge(7) = "EEACAPayrollType"
strEEIDTablesToPurge(8) = "EEAddresses"
strEEIDTablesToPurge(9) = "EEAddressesHist"
strEEIDTablesToPurge(10) = "EEChangeHistory"
strEEIDTablesToPurge(11) = "EECoverageStatusByONeCoverageDate"
strEEIDTablesToPurge(12) = "EEHardships"
strEEIDTablesToPurge(13) = "EEInvElections"
strEEIDTablesToPurge(14) = "EEInvErrs"
strEEIDTablesToPurge(15) = "EEInvest"
strEEIDTablesToPurge(16) = "EEInvestOld"
strEEIDTablesToPurge(17) = "EEInvestOrphans"
strEEIDTablesToPurge(18) = "EELoanPayments"
strEEIDTablesToPurge(19) = "EELoans"
strEEIDTablesToPurge(20) = "EEsELEntry"
strEEIDTablesToPurge(21) = "EETable"
strEEIDTablesToPurge(22) = "EligACAData"
strEEIDTablesToPurge(23) = "meaEEDataEntry"
strEEIDTablesToPurge(24) = "missingEEs"
strEEIDTablesToPurge(25) = "ORIAmerAcctNum"
strEEIDTablesToPurge(26) = "ORICalvertAcctNum"
strEEIDTablesToPurge(27) = "ORIValicAcctNum"
strEEIDTablesToPurge(28) = "PayrollData"
strEEIDTablesToPurge(29) = "PRSplits"
strEEIDTablesToPurge(30) = "zlog_EEHardships"
strEEIDTablesToPurge(31) = "zlog_EELoans"
strEEIDTablesToPurge(32) = "EmployeeData"
End Sub
Private Sub LoadClientIDTableNames()
' ******************************************************************
' Load The Table Names for ClientTransID Removals
' ******************************************************************
strClientIDTablesToPurge(1, 1) = "ACABenefitPremiums"
strClientIDTablesToPurge(2, 1) = "AffiliatedGroupMember"
strClientIDTablesToPurge(3, 1) = "ClientACAConfig"
strClientIDTablesToPurge(4, 1) = "ClientACAConfigHistory"
strClientIDTablesToPurge(5, 1) = "ClientACAPayrollType"
strClientIDTablesToPurge(6, 1) = "ClientACAStdPeriodDates"
strClientIDTablesToPurge(7, 1) = "ClientCustomImportFields"
strClientIDTablesToPurge(8, 1) = "ClientInvest"
strClientIDTablesToPurge(9, 1) = "DeletedEE_ACAEvents"
strClientIDTablesToPurge(10, 1) = "CLRpts"
strClientIDTablesToPurge(11, 1) = "Correspondence"
strClientIDTablesToPurge(12, 1) = "DMClientData"
strClientIDTablesToPurge(13, 1) = "EE_ACACoverageStatus"
strClientIDTablesToPurge(14, 1) = "EE_ACACoverageStatusHistory"
strClientIDTablesToPurge(15, 1) = "EE_ACAEvents"
strClientIDTablesToPurge(16, 1) = "EEACABenefitSelection"
strClientIDTablesToPurge(17, 1) = "EEACAPayrollType"
strClientIDTablesToPurge(18, 1) = "EEAddresses"
strClientIDTablesToPurge(19, 1) = "EEAddressesHist"
strClientIDTablesToPurge(20, 1) = "EECoverageStatusByOneCoverageDate"
strClientIDTablesToPurge(21, 1) = "EELoanPayments"
strClientIDTablesToPurge(22, 1) = "EligACAData"
strClientIDTablesToPurge(23, 1) = "EligACAProcess"
strClientIDTablesToPurge(24, 1) = "EligACAProcessNewFromIMPPTDData"
strClientIDTablesToPurge(25, 1) = "EligChk"
strClientIDTablesToPurge(26, 1) = "EligTemp"
strClientIDTablesToPurge(27, 1) = "ERDepts"
strClientIDTablesToPurge(28, 1) = "ErrorLog"
strClientIDTablesToPurge(29, 1) = "ErrorLogHistory"
strClientIDTablesToPurge(30, 1) = "ImportHistory"
strClientIDTablesToPurge(31, 1) = "Issues"
strClientIDTablesToPurge(32, 1) = "ManuLifeMaps"
strClientIDTablesToPurge(33, 1) = "PayrollDataACA"
strClientIDTablesToPurge(34, 1) = "PayrollDataACAMMM"
strClientIDTablesToPurge(35, 1) = "PRIssues"
strClientIDTablesToPurge(36, 1) = "PRPRocess"
strClientIDTablesToPurge(37, 1) = "PRProcessHistory"
strClientIDTablesToPurge(38, 1) = "PRStatus"
strClientIDTablesToPurge(39, 1) = "PRStatusBoard"
strClientIDTablesToPurge(40, 1) = "zlog_PayrollPDFReports"
' ******************************************************************
' Load The Key Names For The Above 40 Tables Since Names Vary
' ******************************************************************
strClientIDTablesToPurge(1, 2) = "ClientID"
strClientIDTablesToPurge(2, 2) = "ClientTransID"
strClientIDTablesToPurge(3, 2) = "ClientTransID"
strClientIDTablesToPurge(4, 2) = "ClientTransID"
strClientIDTablesToPurge(5, 2) = "ClientID"
strClientIDTablesToPurge(6, 2) = "ClientTransID"
strClientIDTablesToPurge(7, 2) = "ClientTransID"
strClientIDTablesToPurge(8, 2) = "ClientTransID"
strClientIDTablesToPurge(9, 2) = "ClientTransID"
strClientIDTablesToPurge(10, 2) = "ClientTransID"
strClientIDTablesToPurge(11, 2) = "ClientTransID"
strClientIDTablesToPurge(12, 2) = "ClientTransID"
strClientIDTablesToPurge(13, 2) = "ClientTransID"
strClientIDTablesToPurge(14, 2) = "ClientTransID"
strClientIDTablesToPurge(15, 2) = "ClientTransID"
strClientIDTablesToPurge(16, 2) = "ClientID"
strClientIDTablesToPurge(17, 2) = "ClientID"
strClientIDTablesToPurge(18, 2) = "ClientID"
strClientIDTablesToPurge(19, 2) = "ClientID"
strClientIDTablesToPurge(20, 2) = "ClientID"
strClientIDTablesToPurge(21, 2) = "ClientID"
strClientIDTablesToPurge(22, 2) = "ClientID"
strClientIDTablesToPurge(23, 2) = "ClientID"
strClientIDTablesToPurge(24, 2) = "ClientID"
strClientIDTablesToPurge(25, 2) = "ClientTransID"
strClientIDTablesToPurge(26, 2) = "ClientID"
strClientIDTablesToPurge(27, 2) = "ClientTransID"
strClientIDTablesToPurge(28, 2) = "lClientTransID"
strClientIDTablesToPurge(29, 2) = "lClientTransID"
strClientIDTablesToPurge(30, 2) = "ClientTransID"
strClientIDTablesToPurge(31, 2) = "ClientTransID"
strClientIDTablesToPurge(32, 2) = "ClientTransID"
strClientIDTablesToPurge(33, 2) = "ClientID"
strClientIDTablesToPurge(34, 2) = "ClientID"
strClientIDTablesToPurge(35, 2) = "ClientTransID"
strClientIDTablesToPurge(36, 2) = "ClientTransID"
strClientIDTablesToPurge(37, 2) = "ClientTransID"
strClientIDTablesToPurge(38, 2) = "ClientTransID"
strClientIDTablesToPurge(39, 2) = "ClientTransID"
strClientIDTablesToPurge(40, 2) = "ClientID"
End Sub
Private Sub LoadClientPlanTableNames()
strClientPlanTablesToPurge(1) = "CLPMSources"
strClientPlanTablesToPurge(2) = "ER1CalcSpecs"
strClientPlanTablesToPurge(3) = "ClientPlans"
End Sub
Private Sub LoadPlanTableNames()
strPlanTables(1) = "Distributions"
strPlanTables(2) = "PlanInvAccounts"
strPlanTables(3) = "Plans"
End Sub
Private Sub LoadTrustTableNames()
strTrustTables(1) = "TrustAddrs"
strTrustTables(2) = "Trusts"
End Sub
Private Sub LoadWorkingTableNames()
' ******************************************************************
' Load The Table Names for Temporary Tables
' ******************************************************************
strWorkingTableName(1) = "EWEBYTD"
strWorkingTableName(2) = "[Import Table]"
strWorkingTableName(3) = "ImportRawUPTo40Fields"
strWorkingTableName(4) = "ImportRawUpTo80Fields"
strWorkingTableName(5) = "PayrollDataToExport"
strWorkingTableName(6) = "PayrollResults"
strWorkingTableName(7) = "Plan_Contacts"
strWorkingTableName(8) = "PlanStaff"
strWorkingTableName(9) = "PRDataACES"
strWorkingTableName(10) = "REhireTableForReport"
strWorkingTableName(11) = "UnmatchedPersons"
strWorkingTableName(12) = "zlog_DataChanges"
End Sub
Private Sub BuildEEIDArray()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 1 - Build The EEID Array
' ******************************************************************
lngEEIDCount = 0
' ******************************************************************
' Query AllEEsByClientID:
' This Is The Same Query As AllEEsByClientID Except It Has a Where
' Clause To Select Only One Matching Client from the List Box
' ******************************************************************
strSQLListEmployees = "SELECT ClientData.ClientTransID, ClientData.ClientName, ClientPlans.ClientPlanID, " & _
"ClientPlans.ClientPlanCode, EmployeeData.EEID, EmployeeData.SSN, EmployeeData.Dept, EmployeeData.LastName, " & _
"EmployeeData.FirstName, EmployeeData.DOB, EmployeeData.DOH, EmployeeData.DOT " & _
"FROM (ClientData INNER JOIN ClientPlans ON ClientData.ClientTransID=ClientPlans.ClientTransID) " & _
"INNER JOIN EmployeeData ON ClientPlans.ClientPlanID=EmployeeData.ClientPlanID " & _
"WHERE ClientData.ClientTransID=" & lngClientIDToBePurged & ";"
Set recIn = db.OpenRecordset(strSQLListEmployees)
' ******************************************************************
' Loop Through All EEID Records Matching To the Selected Client
' And Add Them To The Array
' ******************************************************************
If Not recIn.EOF Then
Do
lngEEIDCount = lngEEIDCount + 1
ReDim Preserve lngEEIDKeyValues(1 To lngEEIDCount)
lngEEIDKeyValues(lngEEIDCount) = recIn!EEID
recIn.MoveNext
Loop Until recIn.EOF
recIn.Close
Set recIn = Nothing
End If
Exit Sub
' ******************************************************************
' Error Handler
' ******************************************************************
ErrorHandler:
strProcName = "BuildEEIDArray"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub BuildPersonArray()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 1A - Build The Person Array
' ******************************************************************
lngPersonCount = 0
' ******************************************************************
' DLookup To Create Person IDs for Each EEID In The Array
' ******************************************************************
For lngEEIDKeyIndex = LBound(lngEEIDKeyValues) To UBound(lngEEIDKeyValues)
varPersonID = DLookup("[PersonID]", "EmployeeData", "[EEID] = " & lngEEIDKeyValues(lngEEIDKeyIndex))
If Not IsNull(varPersonID) And varPersonID <> 0 Then
lngPersonCount = lngPersonCount + 1
ReDim Preserve lngPersonKeyValues(1 To lngPersonCount)
lngPersonKeyValues(lngPersonCount) = varPersonID
End If
Next lngEEIDKeyIndex
Exit Sub
' ******************************************************************
' Error Handler
' ******************************************************************
ErrorHandler:
strProcName = "BuildPersonArray"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub RemoveEEIDClientRecords()
' ******************************************************************
' STEP 2
' Delete The Employee Records whose EEID Codes
' Are Associated With The Selected Client to Remove
' ******************************************************************
On Error GoTo ErrorHandler
For lngEEIDTableIndex = 1 To 32
For lngEEIDKeyIndex = LBound(lngEEIDKeyValues) To UBound(lngEEIDKeyValues)
' ******************************************************************
' Set Up The EEID Delete Query And Cycle Through All The Tables
' For All The Employees Associated with the Client to Be Removed
' ******************************************************************
strSQL_EEIDRemoval = "DELETE " & strEEIDTablesToPurge(lngEEIDTableIndex) & _
".EEID FROM " & strEEIDTablesToPurge(lngEEIDTableIndex) & " WHERE " & _
strEEIDTablesToPurge(lngEEIDTableIndex) & ".EEID=" & lngEEIDKeyValues(lngEEIDKeyIndex) & ";"
db.Execute strSQL_EEIDRemoval, dbFailOnError
Next lngEEIDKeyIndex
Next lngEEIDTableIndex
Exit Sub
' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveEEIDClientRecords - Table: " & strEEIDTablesToPurge(lngEEIDTableIndex)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub RemoveRecordsFromPersonTable()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 2A
' Remove Persons From PersonData If No Longer Referenced
' In The EmployeeData Table
' ******************************************************************
' ******************************************************************
' If No Persons Were Encountered in the EmployeeData Table
' Skip This Process
' ******************************************************************
If lngPersonCount = 0 Then
Exit Sub
End If
For lngPersonIDKeyIndex = LBound(lngPersonKeyValues) To UBound(lngPersonKeyValues)
' ******************************************************************
' See if the PersonID Still Exists in the EmployeeData Table
' If an EEID still Exists For a PersonID, Then Don't Delete the
' Person
' ******************************************************************
varEEID = DLookup("[EEID]", "EmployeeData", "[PersonId] = " & lngPersonKeyValues(lngPersonIDKeyIndex))
If IsNull(varEEID) Then
strSQLDeletePersonData = "DELETE PersonData.PersonID FROM PersonData WHERE PersonData.PersonID=" & _
lngPersonKeyValues(lngPersonIDKeyIndex) & ";"
db.Execute strSQLDeletePersonData, dbFailOnError
End If
Next lngPersonIDKeyIndex
Exit Sub
' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveRecordsFromPersonTable: PersonData"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub BuildClientPlanIDArray()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 3 - Build The Client Plan Array
' ******************************************************************
lngClientPlanCount = 0
' ******************************************************************
' Extract All ClientPlanIDs from the ClientPlan Table
' That Have Records That Match to the List Box ClientTransID
' ******************************************************************
strSQLExtractClientPlanIDs = "SELECT ClientPlans.ClientPlanID FROM ClientPlans " & _
"WHERE ClientPlans.ClientTransID=" & lngClientIDToBePurged & ";"
Set recIn = db.OpenRecordset(strSQLExtractClientPlanIDs)
' ******************************************************************
' Loop Through All Matching Records And Save The ClientPlanID
' Into The Array
' ******************************************************************
If Not recIn.EOF Then
Do
lngClientPlanCount = lngClientPlanCount + 1
ReDim Preserve lngClientPlanIDKeyValues(1 To lngClientPlanCount)
lngClientPlanIDKeyValues(lngClientPlanCount) = recIn!ClientPlanID
recIn.MoveNext
Loop Until recIn.EOF
recIn.Close
Set recIn = Nothing
End If
Exit Sub
' ******************************************************************
' Error Handler
' ******************************************************************
ErrorHandler:
strProcName = "BuildClientPlanIDArray"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub RemoveRecordsFromClientPlanTables()
' ******************************************************************
' STEP 4 - Remove ClientPlanID Records Matching To
' ClientPlanIDs extracted in Step 3
' ******************************************************************
On Error GoTo ErrorHandler
For lngClientPlanTableIndex = 1 To 3
For lngClientPlanKeyIndex = LBound(lngClientPlanIDKeyValues) To UBound(lngClientPlanIDKeyValues)
' ******************************************************************
' Set Up The ClientPlan Delete Query And Cycle Through All The Tables
' That Use ClientPlanID
' ******************************************************************
strSQLClientPlanIDRemoval = "DELETE " & strClientPlanTablesToPurge(lngClientPlanTableIndex) & _
".ClientPlanID FROM " & strClientPlanTablesToPurge(lngClientPlanTableIndex) & " WHERE " & _
strClientPlanTablesToPurge(lngClientPlanTableIndex) & ".ClientPlanID=" & lngClientPlanIDKeyValues(lngClientPlanKeyIndex) & ";"
db.Execute strSQLClientPlanIDRemoval, dbFailOnError
Next lngClientPlanKeyIndex
Next lngClientPlanTableIndex
Exit Sub
' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveRecordsFromClientPlanTables - Table: " & strClientPlanTablesToPurge(lngClientPlanTableIndex)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub BuildPlanIDArray()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 5 - Build The PlanID Array
' ******************************************************************
lngPlanCount = 0
' ******************************************************************
' Extract All Distinct PlanIDs from the ClientData Table
' That Have Records That Match to the List Box ClientTransID
' ******************************************************************
strSQLExtractPlanIDs = "SELECT Distinct ClientData.PlanID FROM ClientData " & _
"WHERE ClientData.ClientTransID=" & lngClientIDToBePurged & ";"
Set recIn = db.OpenRecordset(strSQLExtractPlanIDs)
' ******************************************************************
' Loop Through All Matching Records And Save The PlanID
' Into The Array
' ******************************************************************
If Not recIn.EOF Then
Do
lngPlanCount = lngPlanCount + 1
ReDim Preserve lngPlanIDKeyValues(1 To lngPlanCount)
lngPlanIDKeyValues(lngPlanCount) = recIn!PlanID
recIn.MoveNext
Loop Until recIn.EOF
recIn.Close
Set recIn = Nothing
End If
Exit Sub
' ******************************************************************
' Error Handler
' ******************************************************************
ErrorHandler:
strProcName = "BuildPlanIDArray"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub BuildTrustIDArray()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 6 - Build The TrustID Array
' ******************************************************************
lngTrustCount = 0
' ******************************************************************
' Extract All Distinct TrustIDs from the Plans Table
' That Have Records That Match to the PlanIDs Array From Step 5
' ******************************************************************
For lngPlanIDIndex = LBound(lngPlanIDKeyValues) To UBound(lngPlanIDKeyValues)
strSQLExtractTrustIDs = "SELECT Distinct Plans.TrustID FROM Plans " & _
"WHERE Plans.PlanID=" & lngPlanIDKeyValues(lngPlanIDIndex) & ";"
Set recIn = db.OpenRecordset(strSQLExtractTrustIDs)
' ******************************************************************
' Loop Through All Matching Records And Save The TrustID
' Into The Array
' ******************************************************************
If Not recIn.EOF Then
Do
lngTrustCount = lngTrustCount + 1
ReDim Preserve lngTrustIDKeyValues(1 To lngTrustCount)
lngTrustIDKeyValues(lngTrustCount) = recIn!trustID
recIn.MoveNext
Loop Until recIn.EOF
recIn.Close
Set recIn = Nothing
End If
Next lngPlanIDIndex
Exit Sub
' ******************************************************************
' Error Handler
' ******************************************************************
ErrorHandler:
strProcName = "BuildTrustIDArray"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub RemoveClientTransIDRecords()
' ******************************************************************
' STEP 7
' Remove Records in Numerous tables That Match to the ClientTransID
' Currently Being Processed from the List Box
' ******************************************************************
On Error GoTo ErrorHandler
For lngClientTransIDTableIndex = 1 To 40
' ******************************************************************
' Set Up The ClientTransID Delete Query And Cycle Through All The Tables
' For All The Records Associated with the Client to Be Removed
' ******************************************************************
strSQL_ClientTransIDRemoval = "DELETE " & _
strClientIDTablesToPurge(lngClientTransIDTableIndex, 1) & "." & strClientIDTablesToPurge(lngClientTransIDTableIndex, 2) & _
" FROM " & strClientIDTablesToPurge(lngClientTransIDTableIndex, 1) & _
" WHERE " & strClientIDTablesToPurge(lngClientTransIDTableIndex, 1) & "." & strClientIDTablesToPurge(lngClientTransIDTableIndex, 2) & _
"=" & lngClientIDToBePurged & ";"
db.Execute strSQL_ClientTransIDRemoval, dbFailOnError
Next lngClientTransIDTableIndex
Exit Sub
' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveClientTransIDRecords - Table: " & strClientIDTablesToPurge(lngClientTransIDTableIndex, 1)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub RemoveClientDataClientTransID()
' ******************************************************************
' STEP 7A
' Remove Records in the ClientData table
' Currently Being Processed from the List Box
' ******************************************************************
On Error GoTo ErrorHandler
' ******************************************************************
' Set Up The Delete Query And Cycle Through All The Tables
' For All The ClientTransIDs Associated with the Client to Be Removed
' ******************************************************************
strSQL_ClientData_ClientTransIDRemoval = "DELETE ClientData.ClientTransID FROM ClientData " & _
" WHERE ClientData.ClientTransID=" & lngClientIDToBePurged & ";"
db.Execute strSQL_ClientData_ClientTransIDRemoval, dbFailOnError
Exit Sub
' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveClientTransIDRecords - Table: ClientData"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub RemovePlanIDs()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 8
' Remove PlanIDs from Multiple Tables
' That Match PlanID
' ******************************************************************
' ******************************************************************
' If No Plans Were Entered in the PlanID Table
' Skip This Process
' ******************************************************************
If lngPlanCount = 0 Then
Exit Sub
End If
' ******************************************************************
' Search In ClientData For Each PlanID In The PlanID Array
' ******************************************************************
For lngPlanIDIndex = LBound(lngPlanIDKeyValues) To UBound(lngPlanIDKeyValues)
' ******************************************************************
' Determine if the PlanID Still Exists in the ClientData Table
' If Yes, then skip the deletes below
' If No, then remove the Plan ID from 3 tables
' ******************************************************************
varClientTransID = DLookup("[ClientTransID]", "ClientData", "[PlanID] = " & lngPlanIDKeyValues(lngPlanIDIndex))
If IsNull(varClientTransID) Then
For lngPlanTableIndex = 1 To 3
strSQLPlanIDRemoval = "DELETE " & strPlanTables(lngPlanTableIndex) & ".PlanId" & _
" FROM " & strPlanTables(lngPlanTableIndex) & " WHERE " & strPlanTables(lngPlanTableIndex) & ".PlanId=" & _
lngPlanIDKeyValues(lngPlanIDIndex) & ";"
db.Execute strSQLPlanIDRemoval, dbFailOnError
Next lngPlanTableIndex
End If
Next lngPlanIDIndex
Exit Sub
' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemovePlanIDs - Table: " & strPlanTables(lngPlanTableIndex)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub RemoveTrustIDs()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 9
' Remove TrustIDs from Multiple Tables
' That Match TrustIDs Saved In Array
' ******************************************************************
' ******************************************************************
' If No Trusts Were Entered in the TrustID Table
' Skip This Process
' ******************************************************************
If lngTrustCount = 0 Then
Exit Sub
End If
' ******************************************************************
' Search In Plans Table For Each TrustID In The TrustID Array
' ******************************************************************
For lngTrustIDIndex = LBound(lngTrustIDKeyValues) To UBound(lngTrustIDKeyValues)
' ******************************************************************
' Determine if the TrustID Still Exists in the Plans Table
' If Yes, then skip the deletes below
' If No, then remove the TrustID from 2 tables
' ******************************************************************
varPlanID = DLookup("[PlanID]", "Plans", "[TrustID] = " & lngTrustIDKeyValues(lngTrustIDIndex))
If IsNull(varPlanID) Then
For lngTrustTableIndex = 1 To 2
strSQLTrustIDRemoval = "DELETE " & strTrustTables(lngTrustTableIndex) & ".TrustId" & _
" FROM " & strTrustTables(lngTrustTableIndex) & " WHERE " & strTrustTables(lngTrustTableIndex) & ".TrustId=" & _
lngTrustIDKeyValues(lngTrustIDIndex) & ";"
db.Execute strSQLTrustIDRemoval, dbFailOnError
Next lngTrustTableIndex
End If
Next lngTrustIDIndex
Exit Sub
' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveTrustIDs - Table: " & strTrustTables(lngTrustTableIndex)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub
Private Sub RemoveWorkingTableRecords()
' ******************************************************************
' STEP 10
' Clear All Rows In Working Tables
' ******************************************************************
On Error GoTo ErrorHandler
For lngWorkingTableNameIndex = 1 To 10
strSQLDeleteWorkingTableRows = "DELETE " & strWorkingTableName(lngWorkingTableNameIndex) & ".* " & _
"FROM " & strWorkingTableName(lngWorkingTableNameIndex) & ";"
db.Execute strSQLDeleteWorkingTableRows, dbFailOnError
Next lngWorkingTableNameIndex
Exit Sub
' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveWorkingTableRecords - Table: " & strWorkingTableName(lngWorkingTableNameIndex)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False
HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next
End Sub