Crosstab query in VBA/SQL (1 Viewer)

jmeek

Registered User.
Local time
Today, 10:44
Joined
Aug 16, 2005
Messages
38
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.


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
 

Users who are viewing this thread

Top Bottom