I need som ehelp please in resolving this VBA/SQL code
which run a crosstab query. The query itself needs to be deleted before running it from the button on the form.
Any help out there much appreciated
which run a crosstab query. The query itself needs to be deleted before running it from the button on the form.
Code:
Private Sub cmdOK_Click()
On Error GoTo cmdOK_Click_Err
Dim blnQueryExists As Boolean
Dim cat As New ADOX.Catalog
Dim cmd As New ADODB.Command
Dim qry As ADOX.View
Dim varItem As Variant
Dim strOffice As String
Dim strDepartment As String
Dim strGender As String
Dim strDepartmentCondition As String
Dim strGenderCondition As String
Dim strSQL As String
' Check for the existence of the stored query
blnQueryExists = False
Set cat.ActiveConnection = CurrentProject.Connection
For Each qry In cat.Views
If qry.Name = "qryCrossTab" Then
blnQueryExists = True
Exit For
End If
Next qry
' Create the query if it does not already exist
If blnQueryExists = False Then
cmd.CommandText = "SELECT * FROM tblStaff"
cat.Views.Append "qryCrossTab", cmd
End If
Application.RefreshDatabaseWindow
' Turn off screen updating
DoCmd.Echo False
' Close the query if it is already open
If SysCmd(acSysCmdGetObjectState, acQuery, "qryCrossTab") = acObjStateOpen Then
DoCmd.Close acQuery, "qryCrossTab"
End If
' Build criteria string for Office
For Each varItem In Me.lstOffice.ItemsSelected
strOffice = strOffice & ",'" & Me.lstOffice.ItemData(varItem) & "'"
Next varItem
If Len(strOffice) = 0 Then
strOffice = "Like '*'"
Else
strOffice = Right(strOffice, Len(strOffice) - 1)
strOffice = "IN(" & strOffice & ")"
End If
' Build criteria string for Department
For Each varItem In Me.lstDepartment.ItemsSelected
strDepartment = strDepartment & ",'" & Me.lstDepartment.ItemData(varItem) & "'"
Next varItem
If Len(strDepartment) = 0 Then
strDepartment = "Like '*'"
Else
strDepartment = Right(strDepartment, Len(strDepartment) - 1)
strDepartment = "IN(" & strDepartment & ")"
End If
' Build criteria string for Gender
For Each varItem In Me.lstGender.ItemsSelected
strGender = strGender & ",'" & Me.lstGender.ItemData(varItem) & "'"
Next varItem
If Len(strGender) = 0 Then
strGender = "Like '*'"
Else
strGender = Right(strGender, Len(strGender) - 1)
strGender = "IN(" & strGender & ")"
End If
' Get Department condition
If Me.optAndDepartment.Value = True Then
strDepartmentCondition = " AND "
Else
strDepartmentCondition = " OR "
End If
' Get Gender condition
If Me.optAndGender.Value = True Then
strGenderCondition = " AND "
Else
strGenderCondition = " OR "
End If
' Build SQL statement
' strSQL = "SELECT tblStaff.* FROM tblStaff " & _
' "WHERE tblStaff.[Office] " & strOffice & _
' strDepartmentCondition & "tblStaff.[Department] " & strDepartment & _
' strGenderCondition & "tblStaff.[Gender] " & strGender & ";"
strSQL = "TRANSFORM Sum(tblStaff.Points) AS SumOfPoints " & _
"SELECT tblStaff.Lastname, tblStaff.Firstname, tblStaff.Department, First(tblStaff.BirthDate) " & _
"AS Start, Last(tblStaff.BirthDate) AS [End], Sum(tblStaff.Points) " & _
"AS [Tot Hrs], WorkingDays([Start],[End]) AS WorkDays, Round([WorkDays]/[Tot Hrs],2) AS [Hrs/Day] " & _
"FROM tblStaff WHERE tblStaff.[Office] " & strOffice & _
strDepartmentCondition & "tblStaff.[Department] " & strDepartment & _
strGenderCondition & "tblStaff.[Gender] " & strGender & _
"GROUP BY tblStaff.Lastname, tblStaff.Firstname, tblStaff.Department " & _
"PIVOT tblStaff.Office;"
' Apply the SQL statement to the stored query
cat.ActiveConnection = CurrentProject.Connection
Set cmd = cat.Views("qryCrossTab").Command
cmd.CommandText = strSQL
Set cat.Views("qryCrossTab").Command = cmd
Set cat = Nothing
' Open the Query
DoCmd.OpenQuery "qryCrossTab"
' If required the dialog can be closed at this point
' DoCmd.Close acForm, Me.Name
' Restore screen updating
cmdOK_Click_Exit:
DoCmd.Echo True
Exit Sub
cmdOK_Click_Err:
MsgBox "An unexpected error hass occurred." _
& vbCrLf & "Procedure: cmdOK_Click" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description:" & Err.Description _
, vbCritical, "Error"
Resume cmdOK_Click_Exit
End Sub
Any help out there much appreciated