Option Compare Database
Private Sub Command3_Click()
End Sub
Private Sub cboSort1_BeforeUpdate(Cancel As Integer)
'Check if sort field has already been chosen
If Me.cboSort1.Value <> "Not sorted" Then
If Me.cboSort1.Value = Me.cboSort2.Value _
Or Me.cboSort1.Value = Me.cboSort3.Value Then
MsgBox "You have already chosen that item."
Cancel = True
Me.cboSort1.Dropdown
End If
End If
End Sub
Private Sub cboSort1_Change()
'Disable following sort options if "Not sorted" is chosen
If Me.cboSort1.Value = "Not sorted" Then
With Me.cboSort2
.Enabled = False
.Value = "Not sorted"
End With
With Me.cboSort3
.Enabled = False
.Value = "Not sorted"
End With
Else
Me.cboSort2.Enabled = True
End If
End Sub
Private Sub cboSort2_BeforeUpdate(Cancel As Integer)
'Check if sort field has already been chosen
If Me.cboSort1.Value <> "Not sorted" Then
If Me.cboSort1.Value = Me.cboSort2.Value _
Or Me.cboSort1.Value = Me.cboSort3.Value Then
MsgBox "You have already chosen that item."
Cancel = True
Me.cboSort2.Dropdown
End If
End If
End Sub
Private Sub cboSort2_Change()
'Disable following sort options if "Not sorted" is chosen
If Me.cboSort2.Value = "Not sorted" Then
With Me.cboSort3
.Enabled = False
.Value = "Not sorted"
End With
Else
Me.cboSort3.Enabled = True
End If
End Sub
Private Sub cboSort3_BeforeUpdate(Cancel As Integer)
'Check if sort field has already been chosen
If Me.cboSort1.Value <> "Not sorted" Then
If Me.cboSort1.Value = Me.cboSort3.Value _
Or Me.cboSort2.Value = Me.cboSort3.Value Then
MsgBox "You have already chosen that item."
Cancel = True
Me.cboSort3.Dropdown
End If
End If
End Sub
Private Sub cmdCancel_Click()
DoCmd.Close acForm, "DIAQRY_BaseQuery"
End Sub
Private Sub cmdOK_Click()
On Error Resume Next
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strCriteriaCtr As String
Dim strSortOrder As String
Dim strFieldList As String
Dim strSQL As String
Dim frm As Form
Dim subfrm As Control
Dim strQueryName As String
Dim strUserName As String
Set db = CurrentDb()
'Set qdf = db.QueryDefs("BaseQuery")
strUserName = Environ("username")
strQueryName = strUserName
'Build Criteria String
If Me!lstAB.ItemsSelected.Count > 0 Then
For Each varItem In Me!lstAB.ItemsSelected
strCriteria = strCriteria & "Centres.[Area Board] = " & Chr(34) _
& Me!lstAB.ItemData(varItem) & Chr(34) & "OR "
Next varItem
strCriteria = Left(strCriteria, Len(strCriteria) - 3)
Else
strCriteria = "Centres.[Area Board] Like '*'"
End If
If Me!lstCtrType.ItemsSelected.Count > 0 Then
For Each varItem In Me!lstCtrType.ItemsSelected
strCriteriaCtr = strCriteriaCtr & "Centres.[Centre Type] = " & Chr(34) _
& Me!lstCtrType.ItemData(varItem) & Chr(34) & "OR "
Next varItem
strCriteriaCtr = Left(strCriteriaCtr, Len(strCriteriaCtr) - 3)
Else
strCriteriaCtr = "Centres.[Centre Type] Like '*'"
End If
'Build sort order code
If Me.cboSort1.Value <> "Not sorted" Then
strSortOrder = " ORDER BY Centres.[" & Me.cboSort1.Value & "]"
If Me.cboSort2.Value <> "Not sorted" Then
strSortOrder = strSortOrder & ",centres.[" & Me.cboSort2.Value & "]"
If Me.cboSort3.Value <> "Not sorted" Then
strSortOrder = strSortOrder & ",centres.[" & Me.cboSort3.Value & "]"
End If
End If
Else
strSortOrder = ""
End If
'Build Field List
strFieldList = "Centres."
If Me!lstFieldList.ItemsSelected.Count > 0 Then
For Each varItem In Me!lstFieldList.ItemsSelected
strFieldList = strFieldList & "[" & Me!lstFieldList.ItemData(varItem) & "], "
Next varItem
strFieldList = Left(strFieldList, Len(strFieldList) - 2)
Else
strFieldList = "*"
End If
strSQL = "SELECT " & strFieldList & " FROM Centres " & _
"Where " & strCriteria & _
" And " & strCriteriaCtr & strSortOrder & ";"
db.QueryDefs.Delete strQueryName
qdf.SQL = strSQL
Set qdf = db.CreateQueryDef(strUserName, strSQL)
Call fDelete_Form 'If subform already exists, delete it
Set frm = CreateForm() 'Create subform in memory
With frm
.Caption = "My Form"
.RecordSource = "BaseQuery"
.DefaultView = 2 'Datasheet View
.RecordSelectors = False
End With
Call fGet_Result_Columns 'Determine which fields will be populating the subform
DoCmd.Save
DoCmd.Close acForm, "form1", acSaveYes 'Needs to be unloaded to place it on the parent form
Set frm = Nothing
DoCmd.OpenForm "Query Results", acNormal 'Open parent form
Set subfrm = Forms![Query Results]!subfrmResults
subfrm.SourceObject = "form1"
DoCmd.Save
Set subfrm = Nothing
Set db = Nothing
Set qdf = Nothing
End Sub
Private Sub Form_Current()
End Sub
Public Function fGet_Result_Columns()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fldcount, i As Long
Set db = CurrentDb
Dim ctl As Control
Set rs = db.OpenRecordset("SELECT TOP 1 * FROM BaseQuery") 'Get a small recordset
fldcount = rs.Fields.Count 'so that we can Count
For Each qry In db.QueryDefs 'Column Headings
If qry.Name = "BaseQuery" Then 'Find the query, get the Column Names
For i = 0 To (fldcount - 1)
Set ctl = CreateControl("form1", acTextBox, acDetail, , _
db.QueryDefs("BaseQuery").Fields(i).Name) 'Create controls equal to
ctl.Name = db.QueryDefs("BaseQuery").Fields(i).Name 'Number of query fields
ctl.Visible = True
Next
End If
Next
Set ctl = Nothing
Set rs = Nothing
Set db = Nothing
End Function
Public Function fDelete_Form()
'Find subform if it exists by looping through the forms collection and then delete it
Dim frm As Object
For Each frm In Application.CurrentProject.AllForms
If frm.Name = "form1" Then
DoCmd.DeleteObject acForm, "form1"
Exit For
End If
Next
Set frm = Nothing
End Function
