Hi I am no DBA or VB , I am supposed to run reports from Crystal and need to use the database and get those results. When I run I get this error. Could anyone please help me with this. I am pasting the code below. thanks.
Run time error 3075 - syntax error (missing operator) in query expression (1 Viewer)
- Thread starter puskardas
- Start date
Function runReports(Period, Year As String, Start, finish As Date)
Dim dbs, rst, rst2
'Check to see if any new assignment groups. If not open form to add them to db.
'Stop
Set dbs = CodeDb
'The below recordset is empty if no known new assignment groups.
'Set rst = CodeDb.OpenRecordset("QyNewAssignmentGroupCheck", dbOpenDynaset)
Set rst = CodeDb.OpenRecordset("SELECT IIF(dbo_probsummarym1.assignment IS NULL,dbo_incidentsm1.tec_owners_assignment, dbo_probsummarym1.assignment) AS [Name] FROM dbo_probsummarym1 RIGHT JOIN (dbo_incidentsm1 LEFT JOIN dbo_screlationm1 ON dbo_incidentsm1.incident_id = dbo_screlationm1.source) ON dbo_probsummarym1.number = dbo_screlationm1.depend " & _
"WHERE dbo_incidentsm1.open_time >=#" & Format(Start, "mm/dd/yyyy") & "# And dbo_incidentsm1.open_time <= #" & Format(finish, "mm/dd/yyyy") & "# " & _
"GROUP BY IIF(dbo_probsummarym1.assignment IS NULL,dbo_incidentsm1.tec_owners_assignment, dbo_probsummarym1.assignment)", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("SELECT [Name] FROM [TBAssignmentGroups] ORDER BY [Name]", dbOpenDynaset)
With rst
' .MoveFirst
'Continue flag is used to tell the database when the user has entered their assignment group.
continue = False
Do While Not .EOF
' First check to see if rst![Name] is in rst
If IsNull(rst![Name]) = False Then
rst2.FindFirst "[Name]='" & rst![Name] & "'"
If rst2.NoMatch = True Then
DoCmd.OpenForm "fmAddAssignmentGroup", acNormal
Forms!fmAddAssignmentGroup.AssignmentNAme.Value = !Name
Do While Not continue
DoEvents
Loop
End If
End If
continue = False
'Give a second for the form to close.
wait (1)
.MoveNext
Loop
End With
rst.Close
rst2.Requery
Set rst = CodeDb.OpenRecordset("SELECT dbo_cm3rm1.request_dept AS [Name] FROM dbo_cm3rm1 " & _
"WHERE dbo_cm3rm1.close_time >=#" & Format(Start, "mm/dd/yyyy") & "# And dbo_cm3rm1.close_time <= #" & Format(finish, "mm/dd/yyyy") & "# " & _
"GROUP BY dbo_cm3rm1.request_dept", dbOpenDynaset)
With rst
' .MoveFirst
'Continue flag is used to tell the database when the user has entered their assignment group.
continue = False
Do While Not .EOF
' First check to see if rst![Name] is in rst
If IsNull(rst![Name]) = False Then
rst2.FindFirst "[Name]='" & rst![Name] & "'"
If rst2.NoMatch = True Then
DoCmd.OpenForm "fmAddAssignmentGroup", acNormal
Forms!fmAddAssignmentGroup.AssignmentNAme.Value = !Name
Do While Not continue
DoEvents
Loop
End If
End If
continue = False
'Give a second for the form to close.
wait (1)
.MoveNext
Loop
End With
rst.Close
dbs.Close
'Prepare Table
Call prepareMainRecords(Period, Year, Start, finish)
'Populate Database
Call data_FTFSR(Period, Year)
'NumberIRs has to be run BEFORE RLAPerformance
Call data_NumberIRs(Period, Year)
Call data_RLAPerformance(Period, Year)
Call data_AgedIRs(Period, Year)
Call data_ChangeSuccess(Period, Year)
Call data_ChangeOnTime(Period, Year)
Call data_ChangeQuality(Period, Year)
'DrillDown EOP Reports
'Call runCRReports(True) (KELLY)
End Function
Function prepareMainRecords(Period, Year, Start, finish)
'This function populates the mainrecords table with every tuple of active
'assignment group and period. This does create a lot of extra unused
'records but it makes crystal reports easier to use as there is data there,
'if not zero.
Dim dbs, rst, rst2
Dim exists, periodIDNo, assignmentGroup As Long
'Add Period to Period Table and return ID field.
exists = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
If IsNull(exists) Then
Set dbs = CodeDb
Set rst = CodeDb.OpenRecordset("tbPeriods", dbOpenDynaset)
With rst
.AddNew
!Period = "P" & Period & " " & Year
!DateFrom = Start
!DateTo = finish
.Update
End With
rst.Close
dbs.Close
exists = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
'Take ID and each assignment group and add to table.
Set dbs = CodeDb
Set rst = CodeDb.OpenRecordset("tbMainRecords", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("Qy_Populate_ActiveAssignments", dbOpenDynaset)
With rst2
.MoveFirst
assignmentGroup = !AssignmentID
End With
Do While Not rst2.EOF
With rst
.AddNew
!PeriodID = exists
!assignmentGroup = assignmentGroup
.Update
End With
With rst2
.MoveNext
If Not rst2.EOF Then
assignmentGroup = !AssignmentID
End If
End With
Loop
rst.Close
dbs.Close
'If period already given then show error.
Else
MsgBox "P" & Period & " " & Year & " already exists"
End If
'Done
End Function
Function data_FTFSR(Period, Year As String)
'This function collates data for the first time fix measure.
Dim PeriodID, assignmentgroupid, FTFSR As Long
Dim dbs, rst, rst2, qdfnew
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
Set qdfnew = dbs.CreateQueryDef("Temp_FTFSR", _
"INSERT INTO tb_Data_FTFSR ( masterData, data_FTFSR ) " & _
"SELECT tbMainRecords.id, Count(qry_dbo_incidentsm1.incident_id) AS CountOfincident_id " & _
"FROM qry_dbo_incidentsm1 INNER JOIN (tbAssignmentGroups INNER JOIN tbMainRecords ON tbAssignmentGroups.AssignmentID = tbMainRecords.AssignmentGroup) ON qry_dbo_incidentsm1.[tec owners assignment] = tbAssignmentGroups.Name " & _
"WHERE (((tbMainRecords.periodid) = " & PeriodID & ") And ((qry_dbo_incidentsm1.tec_first_time_fix) = ""Yes"")) and qry_dbo_incidentsm1.open_time >=#" & returnPeriodStart(Period, Year) & "# And qry_dbo_incidentsm1.open_time <= #" & returnPeriodEnd(Period, Year) & "#" & _
"GROUP BY tbMainRecords.id, qry_dbo_incidentsm1.tec_first_time_fix ")
qdfnew.Execute
GoTo EndOfF
'Create Tempory Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_FTFSR", _
"SELECT tbAssignmentGroups.AssignmentID, Count(dbo_incidentsm1.incident_id) AS CountOfincident_id, dbo_incidentsm1.tec_first_time_fix " & _
"FROM tbAssignmentGroups RIGHT JOIN dbo_incidentsm1 ON tbAssignmentGroups.Name = dbo_incidentsm1.tec_owners_assignment " & _
"GROUP BY tbAssignmentGroups.AssignmentID, dbo_incidentsm1.tec_first_time_fix, dbo_incidentsm1.close_time " & _
"HAVING (((dbo_incidentsm1.tec_first_time_fix)=""Yes"") AND (((dbo_incidentsm1.open_time) >=#" & returnPeriodStart(Period, Year) & "# And (dbo_incidentsm1.open_time) <= #" & returnPeriodEnd(Period, Year) & "#)));")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_FTFSR", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_data_FTFSR", dbOpenDynaset)
Stop
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then
assignmentgroupid = 1 ' 1 = Unknown Group
End If
FTFSR = !countofincident_id
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_FTFSR = FTFSR
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
Dim dbs, rst, rst2
'Check to see if any new assignment groups. If not open form to add them to db.
'Stop
Set dbs = CodeDb
'The below recordset is empty if no known new assignment groups.
'Set rst = CodeDb.OpenRecordset("QyNewAssignmentGroupCheck", dbOpenDynaset)
Set rst = CodeDb.OpenRecordset("SELECT IIF(dbo_probsummarym1.assignment IS NULL,dbo_incidentsm1.tec_owners_assignment, dbo_probsummarym1.assignment) AS [Name] FROM dbo_probsummarym1 RIGHT JOIN (dbo_incidentsm1 LEFT JOIN dbo_screlationm1 ON dbo_incidentsm1.incident_id = dbo_screlationm1.source) ON dbo_probsummarym1.number = dbo_screlationm1.depend " & _
"WHERE dbo_incidentsm1.open_time >=#" & Format(Start, "mm/dd/yyyy") & "# And dbo_incidentsm1.open_time <= #" & Format(finish, "mm/dd/yyyy") & "# " & _
"GROUP BY IIF(dbo_probsummarym1.assignment IS NULL,dbo_incidentsm1.tec_owners_assignment, dbo_probsummarym1.assignment)", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("SELECT [Name] FROM [TBAssignmentGroups] ORDER BY [Name]", dbOpenDynaset)
With rst
' .MoveFirst
'Continue flag is used to tell the database when the user has entered their assignment group.
continue = False
Do While Not .EOF
' First check to see if rst![Name] is in rst
If IsNull(rst![Name]) = False Then
rst2.FindFirst "[Name]='" & rst![Name] & "'"
If rst2.NoMatch = True Then
DoCmd.OpenForm "fmAddAssignmentGroup", acNormal
Forms!fmAddAssignmentGroup.AssignmentNAme.Value = !Name
Do While Not continue
DoEvents
Loop
End If
End If
continue = False
'Give a second for the form to close.
wait (1)
.MoveNext
Loop
End With
rst.Close
rst2.Requery
Set rst = CodeDb.OpenRecordset("SELECT dbo_cm3rm1.request_dept AS [Name] FROM dbo_cm3rm1 " & _
"WHERE dbo_cm3rm1.close_time >=#" & Format(Start, "mm/dd/yyyy") & "# And dbo_cm3rm1.close_time <= #" & Format(finish, "mm/dd/yyyy") & "# " & _
"GROUP BY dbo_cm3rm1.request_dept", dbOpenDynaset)
With rst
' .MoveFirst
'Continue flag is used to tell the database when the user has entered their assignment group.
continue = False
Do While Not .EOF
' First check to see if rst![Name] is in rst
If IsNull(rst![Name]) = False Then
rst2.FindFirst "[Name]='" & rst![Name] & "'"
If rst2.NoMatch = True Then
DoCmd.OpenForm "fmAddAssignmentGroup", acNormal
Forms!fmAddAssignmentGroup.AssignmentNAme.Value = !Name
Do While Not continue
DoEvents
Loop
End If
End If
continue = False
'Give a second for the form to close.
wait (1)
.MoveNext
Loop
End With
rst.Close
dbs.Close
'Prepare Table
Call prepareMainRecords(Period, Year, Start, finish)
'Populate Database
Call data_FTFSR(Period, Year)
'NumberIRs has to be run BEFORE RLAPerformance
Call data_NumberIRs(Period, Year)
Call data_RLAPerformance(Period, Year)
Call data_AgedIRs(Period, Year)
Call data_ChangeSuccess(Period, Year)
Call data_ChangeOnTime(Period, Year)
Call data_ChangeQuality(Period, Year)
'DrillDown EOP Reports
'Call runCRReports(True) (KELLY)
End Function
Function prepareMainRecords(Period, Year, Start, finish)
'This function populates the mainrecords table with every tuple of active
'assignment group and period. This does create a lot of extra unused
'records but it makes crystal reports easier to use as there is data there,
'if not zero.
Dim dbs, rst, rst2
Dim exists, periodIDNo, assignmentGroup As Long
'Add Period to Period Table and return ID field.
exists = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
If IsNull(exists) Then
Set dbs = CodeDb
Set rst = CodeDb.OpenRecordset("tbPeriods", dbOpenDynaset)
With rst
.AddNew
!Period = "P" & Period & " " & Year
!DateFrom = Start
!DateTo = finish
.Update
End With
rst.Close
dbs.Close
exists = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
'Take ID and each assignment group and add to table.
Set dbs = CodeDb
Set rst = CodeDb.OpenRecordset("tbMainRecords", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("Qy_Populate_ActiveAssignments", dbOpenDynaset)
With rst2
.MoveFirst
assignmentGroup = !AssignmentID
End With
Do While Not rst2.EOF
With rst
.AddNew
!PeriodID = exists
!assignmentGroup = assignmentGroup
.Update
End With
With rst2
.MoveNext
If Not rst2.EOF Then
assignmentGroup = !AssignmentID
End If
End With
Loop
rst.Close
dbs.Close
'If period already given then show error.
Else
MsgBox "P" & Period & " " & Year & " already exists"
End If
'Done
End Function
Function data_FTFSR(Period, Year As String)
'This function collates data for the first time fix measure.
Dim PeriodID, assignmentgroupid, FTFSR As Long
Dim dbs, rst, rst2, qdfnew
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
Set qdfnew = dbs.CreateQueryDef("Temp_FTFSR", _
"INSERT INTO tb_Data_FTFSR ( masterData, data_FTFSR ) " & _
"SELECT tbMainRecords.id, Count(qry_dbo_incidentsm1.incident_id) AS CountOfincident_id " & _
"FROM qry_dbo_incidentsm1 INNER JOIN (tbAssignmentGroups INNER JOIN tbMainRecords ON tbAssignmentGroups.AssignmentID = tbMainRecords.AssignmentGroup) ON qry_dbo_incidentsm1.[tec owners assignment] = tbAssignmentGroups.Name " & _
"WHERE (((tbMainRecords.periodid) = " & PeriodID & ") And ((qry_dbo_incidentsm1.tec_first_time_fix) = ""Yes"")) and qry_dbo_incidentsm1.open_time >=#" & returnPeriodStart(Period, Year) & "# And qry_dbo_incidentsm1.open_time <= #" & returnPeriodEnd(Period, Year) & "#" & _
"GROUP BY tbMainRecords.id, qry_dbo_incidentsm1.tec_first_time_fix ")
qdfnew.Execute
GoTo EndOfF
'Create Tempory Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_FTFSR", _
"SELECT tbAssignmentGroups.AssignmentID, Count(dbo_incidentsm1.incident_id) AS CountOfincident_id, dbo_incidentsm1.tec_first_time_fix " & _
"FROM tbAssignmentGroups RIGHT JOIN dbo_incidentsm1 ON tbAssignmentGroups.Name = dbo_incidentsm1.tec_owners_assignment " & _
"GROUP BY tbAssignmentGroups.AssignmentID, dbo_incidentsm1.tec_first_time_fix, dbo_incidentsm1.close_time " & _
"HAVING (((dbo_incidentsm1.tec_first_time_fix)=""Yes"") AND (((dbo_incidentsm1.open_time) >=#" & returnPeriodStart(Period, Year) & "# And (dbo_incidentsm1.open_time) <= #" & returnPeriodEnd(Period, Year) & "#)));")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_FTFSR", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_data_FTFSR", dbOpenDynaset)
Stop
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then
assignmentgroupid = 1 ' 1 = Unknown Group
End If
FTFSR = !countofincident_id
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_FTFSR = FTFSR
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
FTFSR = !countofincident_id
End If
End With
Loop
rst.Close
rst2.Close
EndOfF:
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_FTFSR")
dbs.Close
End Function
Function data_NumberIRs(Period, Year As String)
Dim PeriodID, assignmentgroupid, NumberIRs As Long
Dim dbs, rst, rst2, qdfnew
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
Set qdfnew = dbs.CreateQueryDef("Temp_NumberIRs", _
"INSERT INTO tb_data_NumberIRs ( masterData, data_NumberIRs ) " & _
"SELECT tbMainRecords.id, Count(qry_dbo_probsummarym1.number) AS CountOfNumber " & _
"FROM qry_dbo_probsummarym1 INNER JOIN (tbAssignmentGroups INNER JOIN tbMainRecords ON tbAssignmentGroups.AssignmentID = tbMainRecords.AssignmentGroup) ON qry_dbo_probsummarym1.[Assignment Name] = tbAssignmentGroups.Name " & _
"WHERE tbMainRecords.periodid = " & PeriodID & " And qry_dbo_probsummarym1.open_time >=#" & returnPeriodStart(Period, Year) & "# And qry_dbo_probsummarym1.open_time <= #" & returnPeriodEnd(Period, Year) & "#" & _
"GROUP BY tbMainRecords.id")
qdfnew.Execute
GoTo EndOfF
'Create Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_NumberIRs", _
"SELECT Count(dbo_probsummarym1.number) AS CountOfnumber, tbAssignmentGroups.AssignmentID " & _
"FROM (dbo_probsummarym1 INNER JOIN dbo_probsummarym2 ON dbo_probsummarym1.number = dbo_probsummarym2.number) LEFT JOIN tbAssignmentGroups ON dbo_probsummarym1.assignment = tbAssignmentGroups.Name " & _
"WHERE (((dbo_probsummarym1.open_time) >=#" & returnPeriodStart(Period, Year) & "# And (dbo_probsummarym1.open_time) <= #" & returnPeriodEnd(Period, Year) & "#)) " & _
"GROUP BY tbAssignmentGroups.AssignmentID;")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_NumberIRs", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_data_NumberIRs", dbOpenDynaset)
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
NumberIRs = !CountOfnumber
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_NumberIRs = NumberIRs
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
NumberIRs = !CountOfnumber
End If
End With
Loop
rst.Close
rst2.Close
EndOfF:
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_NumberIRs")
dbs.Close
End Function
Function data_RLAPerformance(Period, Year As String)
Dim PeriodID, assignmentgroupid, OutRLA As Long
Dim dbs, rst, rst2, qdfnew
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
'Create Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_RLAPerformance", _
"SELECT tbAssignmentGroups.AssignmentID, Count(dbo_probsummarym1.number) AS OutRLA " & _
"FROM (dbo_probsummarym1 INNER JOIN dbo_probsummarym2 ON dbo_probsummarym1.number = dbo_probsummarym2.number) LEFT JOIN tbAssignmentGroups ON dbo_probsummarym1.assignment = tbAssignmentGroups.Name " & _
"WHERE (((dbo_probsummarym1.deadline) = ""t"") And (((dbo_probsummarym1.open_time) >=#" & returnPeriodStart(Period, Year) & "# And (dbo_probsummarym1.open_time) <= #" & returnPeriodEnd(Period, Year) & "#)))" & _
"GROUP BY tbAssignmentGroups.AssignmentID;")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_RLAPErformance", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_data_RLAPerformance", dbOpenDynaset)
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
OutRLA = !OutRLA
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_OutRLA = OutRLA
If IsNull(DLookup("data_NumberIRs", "tb_Data_NumberIRs", "[masterdata] = " & !masterdata)) Then MsgBox "run data_number_IRs first"
!data_InRLA = DLookup("data_NumberIRs", "tb_Data_NumberIRs", "[masterdata] = " & !masterdata) - OutRLA
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
OutRLA = !OutRLA
End If
End With
Loop
rst.Close
rst2.Close
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_RLAPerformance")
'This below HAS to be run after UpdateBlanks_RLAPErformance
DoCmd.OpenQuery ("Qy_Update_InRLABlanks")
dbs.Close
End Function
Function data_AgedIRs(Period, Year As String)
Dim counter As Integer
Dim PeriodID As Long
Dim dbs As Database
'DoCmd.OpenForm ("FmStatus")
Set dbs = CodeDb
'For Each Priority
counter = 1
Do While counter <> 6
FTFSR = !countofincident_id
End If
End With
Loop
rst.Close
rst2.Close
EndOfF:
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_FTFSR")
dbs.Close
End Function
Function data_NumberIRs(Period, Year As String)
Dim PeriodID, assignmentgroupid, NumberIRs As Long
Dim dbs, rst, rst2, qdfnew
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
Set qdfnew = dbs.CreateQueryDef("Temp_NumberIRs", _
"INSERT INTO tb_data_NumberIRs ( masterData, data_NumberIRs ) " & _
"SELECT tbMainRecords.id, Count(qry_dbo_probsummarym1.number) AS CountOfNumber " & _
"FROM qry_dbo_probsummarym1 INNER JOIN (tbAssignmentGroups INNER JOIN tbMainRecords ON tbAssignmentGroups.AssignmentID = tbMainRecords.AssignmentGroup) ON qry_dbo_probsummarym1.[Assignment Name] = tbAssignmentGroups.Name " & _
"WHERE tbMainRecords.periodid = " & PeriodID & " And qry_dbo_probsummarym1.open_time >=#" & returnPeriodStart(Period, Year) & "# And qry_dbo_probsummarym1.open_time <= #" & returnPeriodEnd(Period, Year) & "#" & _
"GROUP BY tbMainRecords.id")
qdfnew.Execute
GoTo EndOfF
'Create Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_NumberIRs", _
"SELECT Count(dbo_probsummarym1.number) AS CountOfnumber, tbAssignmentGroups.AssignmentID " & _
"FROM (dbo_probsummarym1 INNER JOIN dbo_probsummarym2 ON dbo_probsummarym1.number = dbo_probsummarym2.number) LEFT JOIN tbAssignmentGroups ON dbo_probsummarym1.assignment = tbAssignmentGroups.Name " & _
"WHERE (((dbo_probsummarym1.open_time) >=#" & returnPeriodStart(Period, Year) & "# And (dbo_probsummarym1.open_time) <= #" & returnPeriodEnd(Period, Year) & "#)) " & _
"GROUP BY tbAssignmentGroups.AssignmentID;")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_NumberIRs", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_data_NumberIRs", dbOpenDynaset)
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
NumberIRs = !CountOfnumber
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_NumberIRs = NumberIRs
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
NumberIRs = !CountOfnumber
End If
End With
Loop
rst.Close
rst2.Close
EndOfF:
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_NumberIRs")
dbs.Close
End Function
Function data_RLAPerformance(Period, Year As String)
Dim PeriodID, assignmentgroupid, OutRLA As Long
Dim dbs, rst, rst2, qdfnew
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
'Create Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_RLAPerformance", _
"SELECT tbAssignmentGroups.AssignmentID, Count(dbo_probsummarym1.number) AS OutRLA " & _
"FROM (dbo_probsummarym1 INNER JOIN dbo_probsummarym2 ON dbo_probsummarym1.number = dbo_probsummarym2.number) LEFT JOIN tbAssignmentGroups ON dbo_probsummarym1.assignment = tbAssignmentGroups.Name " & _
"WHERE (((dbo_probsummarym1.deadline) = ""t"") And (((dbo_probsummarym1.open_time) >=#" & returnPeriodStart(Period, Year) & "# And (dbo_probsummarym1.open_time) <= #" & returnPeriodEnd(Period, Year) & "#)))" & _
"GROUP BY tbAssignmentGroups.AssignmentID;")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_RLAPErformance", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_data_RLAPerformance", dbOpenDynaset)
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
OutRLA = !OutRLA
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_OutRLA = OutRLA
If IsNull(DLookup("data_NumberIRs", "tb_Data_NumberIRs", "[masterdata] = " & !masterdata)) Then MsgBox "run data_number_IRs first"
!data_InRLA = DLookup("data_NumberIRs", "tb_Data_NumberIRs", "[masterdata] = " & !masterdata) - OutRLA
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
OutRLA = !OutRLA
End If
End With
Loop
rst.Close
rst2.Close
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_RLAPerformance")
'This below HAS to be run after UpdateBlanks_RLAPErformance
DoCmd.OpenQuery ("Qy_Update_InRLABlanks")
dbs.Close
End Function
Function data_AgedIRs(Period, Year As String)
Dim counter As Integer
Dim PeriodID As Long
Dim dbs As Database
'DoCmd.OpenForm ("FmStatus")
Set dbs = CodeDb
'For Each Priority
counter = 1
Do While counter <> 6
'Create Query Definition and Append to Table
Call data_agedIRs_AppendData(Period, Year, counter)
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_AgedIRsP" & counter)
'Change Counter
counter = counter + 1
Loop
End Function
Function data_agedIRs_AppendData(Period, Year As String, priority As Integer)
Dim PeriodID, assignmentgroupid, keyfield As Long
Dim duration, SumIRs, masterDataId As Integer
Dim counter As Integer
Dim dbs, rst, rst2, qdfnew
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
'Create Query
Set qdfnew = dbs.CreateQueryDef("Temp_AgedIRsP" & priority, _
"SELECT tbAssignmentGroups.AssignmentID, DateDiff(""d"",[open_time],Now()) AS Duration, Count(dbo_probsummarym1.number) AS CountOfnumber " & _
"FROM (dbo_probsummarym1 INNER JOIN dbo_probsummarym2 ON dbo_probsummarym1.number = dbo_probsummarym2.number) INNER JOIN tbAssignmentGroups ON dbo_probsummarym1.assignment = tbAssignmentGroups.Name " & _
"WHERE (Not (dbo_probsummarym1.status)=""closed"") And ((dbo_probsummarym1.user_priority) Like """ & priority & "*"") " & _
"GROUP BY tbAssignmentGroups.AssignmentID, DateDiff(""d"",[open_time],Now()) " & _
"ORDER BY tbAssignmentGroups.AssignmentID, DateDiff(""d"",[open_time],Now());")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_AgedIRsP" & priority, dbOpenSnapshot)
Set rst2 = CodeDb.OpenRecordset("tb_Data_AgedIncidents_P" & priority, dbOpenDynaset)
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
duration = !duration
SumIRs = !CountOfnumber
End If
End With
Do While Not rst.EOF
'find Record ID
masterDataId = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
If IsNull(DLookup("idno", "tb_Data_AgedIncidents_P" & priority, "[masterdata] = " & masterDataId)) Then
With rst2
' Call Forms.FmStatus.counterIncrement("", "", "Adding")
.AddNew
!masterdata = masterDataId
If duration <= 1 Then
!data_lessone = SumIRs
ElseIf duration <= 5 Then
!data_onefive = SumIRs
ElseIf duration <= 10 Then
!data_fiveten = SumIRs
ElseIf duration <= 20 Then
!data_tentwenty = SumIRs
ElseIf duration <= 30 Then
!data_twentythirty = SumIRs
ElseIf duration <= 40 Then
!data_thirtyfourty = SumIRs
Else
!data_fourtyplus = SumIRs
End If
.Update
End With
Else
With rst2
' Call Forms.FmStatus.counterIncrement("", "", "Modifying")
.MoveLast
keyfield = DLookup("idno", "tb_Data_AgedIncidents_P" & priority, "[masterdata] = " & masterDataId)
Do While Not rst2.BOF
If keyfield = !idno Then
.Edit
If duration <= 1 Then
!data_lessone = !data_lessone + SumIRs
ElseIf duration <= 5 Then
!data_onefive = !data_onefive + SumIRs
ElseIf duration <= 10 Then
!data_fiveten = !data_fiveten + SumIRs
ElseIf duration <= 20 Then
!data_tentwenty = !data_tentwenty + SumIRs
ElseIf duration <= 30 Then
!data_twentythirty = !data_twentythirty + SumIRs
ElseIf duration <= 40 Then
!data_thirtyfourty = !data_thirtyfourty + SumIRs
Else
!data_fourtyplus = !data_fourtyplus + SumIRs
End If
.Update
.MoveFirst
End If
.MovePrevious
Loop
End With
End If
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
duration = !duration
SumIRs = !CountOfnumber
'Call Forms.FmStatus.counterIncrement("", duration, "")
End If
End With
Loop
rst.Close
rst2.Close
dbs.QueryDefs.Delete qdfnew.Name
End Function
Function data_ChangeSuccess(Period, Year As String)
Dim PeriodID, assignmentgroupid, successful, successfulProbs, partialsuccess, partialsuccessprobs, unsuccessful, withdrawn As Long
Dim dbs, rst, rst2, qdfnew, qdfnew2
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
'Create Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_ChangeSuccess", _
"SELECT dbo_cm3rm1.request_dept, dbo_cm3rm1.completion_code, Count(dbo_cm3rm1.number) AS CountOfnumber " & _
"FROM dbo_cm3rm1 INNER JOIN dbo_cm3rm2 ON dbo_cm3rm1.number = dbo_cm3rm2.number " & _
"WHERE (((dbo_cm3rm1.close_time) >= #" & returnPeriodStart(Period, Year) & "# And (dbo_cm3rm1.close_time) <= #" & returnPeriodEnd(Period, Year) & "#)) AND (Not (dbo_cm3rm1.completion_code)=6)" & _
"GROUP BY dbo_cm3rm1.request_dept, dbo_cm3rm1.completion_code;")
Set qdfnew2 = dbs.CreateQueryDef("Temp_ChangeSuccess_CrossTab", _
"TRANSFORM Sum(Temp_ChangeSuccess.CountOfnumber) AS [The Value] " & _
"SELECT tbAssignmentGroups.AssignmentID, Sum(Temp_ChangeSuccess.CountOfnumber) AS [Total Of CountOfnumber] " & _
"FROM Temp_ChangeSuccess INNER JOIN tbAssignmentGroups ON Temp_ChangeSuccess.request_dept = tbAssignmentGroups.Name " & _
"GROUP BY tbAssignmentGroups.AssignmentID " & _
"PIVOT ""data_Cat"" & [completion_code];")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_ChangeSuccess_CrossTab", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_Data_Change_Success", dbOpenDynaset)
successful = 0
successfulProbs = 0
partialsuccess = 0
partialsuccessprobs = 0
unsuccessful = 0
withdrawn = 0
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!data_cat1) Then successful = 0 Else successful = !data_cat1
If IsNull(!data_cat2) Then successfulProbs = 0 Else successfulProbs = !data_cat2
If IsNull(!data_cat3) Then partialsuccess = 0 Else partialsuccess = !data_cat3
If IsNull(!data_cat4) Then partialsuccessprobs = 0 Else partialsuccessprobs = !data_cat4
If IsNull(!data_cat5) Then unsuccessful = 0 Else unsuccessful = !data_cat5
If IsNull(!data_cat6) Then withdrawn = 0 Else withdrawn = !data_cat6
On Error GoTo 0
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_successful = successful
!data_successfulprobs = successfulProbs
!data_partialsuccess = partialsuccess
!data_partialsuccessprobs = partialsuccessprobs
!data_unsuccessful = unsuccessful
!data_withdrawn = withdrawn
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!data_cat1) Then successful = 0 Else successful = !data_cat1
If IsNull(!data_cat2) Then successfulProbs = 0 Else successfulProbs = !data_cat2
If IsNull(!data_cat3) Then partialsuccess = 0 Else partialsuccess = !data_cat3
If IsNull(!data_cat4) Then partialsuccessprobs = 0 Else partialsuccessprobs = !data_cat4
If IsNull(!data_cat5) Then unsuccessful = 0 Else unsuccessful = !data_cat5
If IsNull(!data_cat6) Then withdrawn = 0 Else withdrawn = !data_cat6
On Error GoTo 0
End If
End With
Loop
rst.Close
rst2.Close
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
dbs.QueryDefs.Delete qdfnew2.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_ChangeSuccess")
dbs.Close
End Function
Call data_agedIRs_AppendData(Period, Year, counter)
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_AgedIRsP" & counter)
'Change Counter
counter = counter + 1
Loop
End Function
Function data_agedIRs_AppendData(Period, Year As String, priority As Integer)
Dim PeriodID, assignmentgroupid, keyfield As Long
Dim duration, SumIRs, masterDataId As Integer
Dim counter As Integer
Dim dbs, rst, rst2, qdfnew
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
'Create Query
Set qdfnew = dbs.CreateQueryDef("Temp_AgedIRsP" & priority, _
"SELECT tbAssignmentGroups.AssignmentID, DateDiff(""d"",[open_time],Now()) AS Duration, Count(dbo_probsummarym1.number) AS CountOfnumber " & _
"FROM (dbo_probsummarym1 INNER JOIN dbo_probsummarym2 ON dbo_probsummarym1.number = dbo_probsummarym2.number) INNER JOIN tbAssignmentGroups ON dbo_probsummarym1.assignment = tbAssignmentGroups.Name " & _
"WHERE (Not (dbo_probsummarym1.status)=""closed"") And ((dbo_probsummarym1.user_priority) Like """ & priority & "*"") " & _
"GROUP BY tbAssignmentGroups.AssignmentID, DateDiff(""d"",[open_time],Now()) " & _
"ORDER BY tbAssignmentGroups.AssignmentID, DateDiff(""d"",[open_time],Now());")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_AgedIRsP" & priority, dbOpenSnapshot)
Set rst2 = CodeDb.OpenRecordset("tb_Data_AgedIncidents_P" & priority, dbOpenDynaset)
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
duration = !duration
SumIRs = !CountOfnumber
End If
End With
Do While Not rst.EOF
'find Record ID
masterDataId = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
If IsNull(DLookup("idno", "tb_Data_AgedIncidents_P" & priority, "[masterdata] = " & masterDataId)) Then
With rst2
' Call Forms.FmStatus.counterIncrement("", "", "Adding")
.AddNew
!masterdata = masterDataId
If duration <= 1 Then
!data_lessone = SumIRs
ElseIf duration <= 5 Then
!data_onefive = SumIRs
ElseIf duration <= 10 Then
!data_fiveten = SumIRs
ElseIf duration <= 20 Then
!data_tentwenty = SumIRs
ElseIf duration <= 30 Then
!data_twentythirty = SumIRs
ElseIf duration <= 40 Then
!data_thirtyfourty = SumIRs
Else
!data_fourtyplus = SumIRs
End If
.Update
End With
Else
With rst2
' Call Forms.FmStatus.counterIncrement("", "", "Modifying")
.MoveLast
keyfield = DLookup("idno", "tb_Data_AgedIncidents_P" & priority, "[masterdata] = " & masterDataId)
Do While Not rst2.BOF
If keyfield = !idno Then
.Edit
If duration <= 1 Then
!data_lessone = !data_lessone + SumIRs
ElseIf duration <= 5 Then
!data_onefive = !data_onefive + SumIRs
ElseIf duration <= 10 Then
!data_fiveten = !data_fiveten + SumIRs
ElseIf duration <= 20 Then
!data_tentwenty = !data_tentwenty + SumIRs
ElseIf duration <= 30 Then
!data_twentythirty = !data_twentythirty + SumIRs
ElseIf duration <= 40 Then
!data_thirtyfourty = !data_thirtyfourty + SumIRs
Else
!data_fourtyplus = !data_fourtyplus + SumIRs
End If
.Update
.MoveFirst
End If
.MovePrevious
Loop
End With
End If
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
duration = !duration
SumIRs = !CountOfnumber
'Call Forms.FmStatus.counterIncrement("", duration, "")
End If
End With
Loop
rst.Close
rst2.Close
dbs.QueryDefs.Delete qdfnew.Name
End Function
Function data_ChangeSuccess(Period, Year As String)
Dim PeriodID, assignmentgroupid, successful, successfulProbs, partialsuccess, partialsuccessprobs, unsuccessful, withdrawn As Long
Dim dbs, rst, rst2, qdfnew, qdfnew2
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
'Create Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_ChangeSuccess", _
"SELECT dbo_cm3rm1.request_dept, dbo_cm3rm1.completion_code, Count(dbo_cm3rm1.number) AS CountOfnumber " & _
"FROM dbo_cm3rm1 INNER JOIN dbo_cm3rm2 ON dbo_cm3rm1.number = dbo_cm3rm2.number " & _
"WHERE (((dbo_cm3rm1.close_time) >= #" & returnPeriodStart(Period, Year) & "# And (dbo_cm3rm1.close_time) <= #" & returnPeriodEnd(Period, Year) & "#)) AND (Not (dbo_cm3rm1.completion_code)=6)" & _
"GROUP BY dbo_cm3rm1.request_dept, dbo_cm3rm1.completion_code;")
Set qdfnew2 = dbs.CreateQueryDef("Temp_ChangeSuccess_CrossTab", _
"TRANSFORM Sum(Temp_ChangeSuccess.CountOfnumber) AS [The Value] " & _
"SELECT tbAssignmentGroups.AssignmentID, Sum(Temp_ChangeSuccess.CountOfnumber) AS [Total Of CountOfnumber] " & _
"FROM Temp_ChangeSuccess INNER JOIN tbAssignmentGroups ON Temp_ChangeSuccess.request_dept = tbAssignmentGroups.Name " & _
"GROUP BY tbAssignmentGroups.AssignmentID " & _
"PIVOT ""data_Cat"" & [completion_code];")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_ChangeSuccess_CrossTab", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_Data_Change_Success", dbOpenDynaset)
successful = 0
successfulProbs = 0
partialsuccess = 0
partialsuccessprobs = 0
unsuccessful = 0
withdrawn = 0
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!data_cat1) Then successful = 0 Else successful = !data_cat1
If IsNull(!data_cat2) Then successfulProbs = 0 Else successfulProbs = !data_cat2
If IsNull(!data_cat3) Then partialsuccess = 0 Else partialsuccess = !data_cat3
If IsNull(!data_cat4) Then partialsuccessprobs = 0 Else partialsuccessprobs = !data_cat4
If IsNull(!data_cat5) Then unsuccessful = 0 Else unsuccessful = !data_cat5
If IsNull(!data_cat6) Then withdrawn = 0 Else withdrawn = !data_cat6
On Error GoTo 0
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_successful = successful
!data_successfulprobs = successfulProbs
!data_partialsuccess = partialsuccess
!data_partialsuccessprobs = partialsuccessprobs
!data_unsuccessful = unsuccessful
!data_withdrawn = withdrawn
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!data_cat1) Then successful = 0 Else successful = !data_cat1
If IsNull(!data_cat2) Then successfulProbs = 0 Else successfulProbs = !data_cat2
If IsNull(!data_cat3) Then partialsuccess = 0 Else partialsuccess = !data_cat3
If IsNull(!data_cat4) Then partialsuccessprobs = 0 Else partialsuccessprobs = !data_cat4
If IsNull(!data_cat5) Then unsuccessful = 0 Else unsuccessful = !data_cat5
If IsNull(!data_cat6) Then withdrawn = 0 Else withdrawn = !data_cat6
On Error GoTo 0
End If
End With
Loop
rst.Close
rst2.Close
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
dbs.QueryDefs.Delete qdfnew2.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_ChangeSuccess")
dbs.Close
End Function
Function data_ChangeOnTime(Period, Year As String)
Dim PeriodID, assignmentgroupid, late, latebusiness, notclassified, ontime As Long
Dim dbs, rst, rst2, qdfnew, qdfnew2
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
'Create Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_ChangeOnTime", _
"SELECT tbAssignmentGroups.AssignmentID, dbo_cm3rm2.tec_time_quality, tb_Change_OnTime_Polished.PolishedName, Count(dbo_cm3rm1.number) AS CountOfnumber " & _
"FROM ((dbo_cm3rm1 INNER JOIN dbo_cm3rm2 ON dbo_cm3rm1.number = dbo_cm3rm2.number) LEFT JOIN tbAssignmentGroups ON dbo_cm3rm1.request_dept = tbAssignmentGroups.Name) LEFT JOIN tb_Change_OnTime_Polished ON dbo_cm3rm2.tec_time_quality = tb_Change_OnTime_Polished.RawName " & _
"WHERE (((dbo_cm3rm1.close_time) >=#" & returnPeriodStart(Period, Year) & "# And (dbo_cm3rm1.close_time) <= #" & returnPeriodEnd(Period, Year) & "#)) AND (Not (dbo_cm3rm1.completion_code)=6)" & _
"GROUP BY tbAssignmentGroups.AssignmentID, dbo_cm3rm2.tec_time_quality, tb_Change_OnTime_Polished.PolishedName;")
Set qdfnew2 = dbs.CreateQueryDef("Temp_ChangeOnTime_CrossTab ", _
"TRANSFORM Sum(Temp_ChangeOnTime.CountOfnumber) AS [The Value] " & _
"SELECT Temp_ChangeOnTime.AssignmentID, Sum(Temp_ChangeOnTime.CountOfnumber) AS [Total Of CountOfnumber] " & _
"FROM Temp_ChangeOnTime " & _
"GROUP BY Temp_ChangeOnTime.AssignmentID " & _
"PIVOT ""d"" & Temp_ChangeOnTime.PolishedName;")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_ChangeOnTime_CrossTab", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_Data_Change_OnTime", dbOpenDynaset)
late = 0
notclassified = 0
latebusiness = 0
ontime = 0
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!ddata_late) Then late = 0 Else late = !ddata_late
If IsNull(!ddata_latebusiness) Then latebusiness = 0 Else latebusiness = !ddata_latebusiness
If IsNull(!ddata_ontime) Then ontime = 0 Else ontime = !ddata_ontime
On Error GoTo 0
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_notclassified = notclassified
!data_late = late
!data_latebusiness = latebusiness
!data_ontime = ontime
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!ddata_late) Then late = 0 Else late = !ddata_late
If IsNull(!ddata_latebusiness) Then latebusiness = 0 Else latebusiness = !ddata_latebusiness
If IsNull(!ddata_ontime) Then ontime = 0 Else ontime = !ddata_ontime
On Error GoTo 0
End If
End With
Loop
rst.Close
rst2.Close
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
dbs.QueryDefs.Delete qdfnew2.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_ChangeOnTime")
dbs.Close
End Function
Function data_ChangeQuality(Period, Year As String)
Dim PeriodID, assignmentgroupid, Excellent, Acceptable, Poor As Long
Dim dbs, rst, rst2, qdfnew, qdfnew2
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
'Create Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_ChangeQuality", _
"SELECT tbAssignmentGroups.AssignmentID, dbo_cm3rm1.close_time, dbo_cm3rm2.tec_overall_quality, dbo_cm3rm1.number " & _
"FROM (dbo_cm3rm1 INNER JOIN dbo_cm3rm2 ON dbo_cm3rm1.number = dbo_cm3rm2.number) LEFT JOIN tbAssignmentGroups ON dbo_cm3rm1.request_dept = tbAssignmentGroups.Name " & _
"WHERE (((dbo_cm3rm1.close_time)>=#" & returnPeriodStart(Period, Year) & "# And (dbo_cm3rm1.close_time) <= #" & returnPeriodEnd(Period, Year) & "#)) AND (Not (dbo_cm3rm1.completion_code)=6);")
Set qdfnew2 = dbs.CreateQueryDef("Temp_ChangeQuality_CrossTab ", _
"TRANSFORM Count(Temp_ChangeQuality.close_time) AS [The Value] " & _
"SELECT Temp_ChangeQuality.AssignmentID, Count(Temp_ChangeQuality.number) AS CountOfnumber " & _
"FROM Temp_ChangeQuality " & _
"GROUP BY Temp_ChangeQuality.AssignmentID " & _
"PIVOT ""Data_"" & Temp_ChangeQuality.tec_overall_quality;")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_ChangeQuality_CrossTab", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_Data_Change_Quality", dbOpenDynaset)
Excellent = 0
Acceptable = 0
Poor = 0
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!Data_1) Then Excellent = 0 Else Excellent = !Data_1
If IsNull(!data_2) Then Acceptable = 0 Else Acceptable = !data_2
If IsNull(!data_3) Then Poor = 0 Else Poor = !data_3
On Error GoTo 0
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_excellent = Excellent
!data_acceptable = Acceptable
!data_poor = Poor
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!Data_1) Then Excellent = 0 Else Excellent = !Data_1
If IsNull(!data_2) Then Acceptable = 0 Else Acceptable = !data_2
If IsNull(!data_3) Then Poor = 0 Else Poor = !data_3
On Error GoTo 0
End If
End With
Loop
rst.Close
rst2.Close
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
dbs.QueryDefs.Delete qdfnew2.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_ChangeQuality")
dbs.Close
End Function
Dim PeriodID, assignmentgroupid, late, latebusiness, notclassified, ontime As Long
Dim dbs, rst, rst2, qdfnew, qdfnew2
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
'Create Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_ChangeOnTime", _
"SELECT tbAssignmentGroups.AssignmentID, dbo_cm3rm2.tec_time_quality, tb_Change_OnTime_Polished.PolishedName, Count(dbo_cm3rm1.number) AS CountOfnumber " & _
"FROM ((dbo_cm3rm1 INNER JOIN dbo_cm3rm2 ON dbo_cm3rm1.number = dbo_cm3rm2.number) LEFT JOIN tbAssignmentGroups ON dbo_cm3rm1.request_dept = tbAssignmentGroups.Name) LEFT JOIN tb_Change_OnTime_Polished ON dbo_cm3rm2.tec_time_quality = tb_Change_OnTime_Polished.RawName " & _
"WHERE (((dbo_cm3rm1.close_time) >=#" & returnPeriodStart(Period, Year) & "# And (dbo_cm3rm1.close_time) <= #" & returnPeriodEnd(Period, Year) & "#)) AND (Not (dbo_cm3rm1.completion_code)=6)" & _
"GROUP BY tbAssignmentGroups.AssignmentID, dbo_cm3rm2.tec_time_quality, tb_Change_OnTime_Polished.PolishedName;")
Set qdfnew2 = dbs.CreateQueryDef("Temp_ChangeOnTime_CrossTab ", _
"TRANSFORM Sum(Temp_ChangeOnTime.CountOfnumber) AS [The Value] " & _
"SELECT Temp_ChangeOnTime.AssignmentID, Sum(Temp_ChangeOnTime.CountOfnumber) AS [Total Of CountOfnumber] " & _
"FROM Temp_ChangeOnTime " & _
"GROUP BY Temp_ChangeOnTime.AssignmentID " & _
"PIVOT ""d"" & Temp_ChangeOnTime.PolishedName;")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_ChangeOnTime_CrossTab", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_Data_Change_OnTime", dbOpenDynaset)
late = 0
notclassified = 0
latebusiness = 0
ontime = 0
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!ddata_late) Then late = 0 Else late = !ddata_late
If IsNull(!ddata_latebusiness) Then latebusiness = 0 Else latebusiness = !ddata_latebusiness
If IsNull(!ddata_ontime) Then ontime = 0 Else ontime = !ddata_ontime
On Error GoTo 0
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_notclassified = notclassified
!data_late = late
!data_latebusiness = latebusiness
!data_ontime = ontime
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!ddata_late) Then late = 0 Else late = !ddata_late
If IsNull(!ddata_latebusiness) Then latebusiness = 0 Else latebusiness = !ddata_latebusiness
If IsNull(!ddata_ontime) Then ontime = 0 Else ontime = !ddata_ontime
On Error GoTo 0
End If
End With
Loop
rst.Close
rst2.Close
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
dbs.QueryDefs.Delete qdfnew2.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_ChangeOnTime")
dbs.Close
End Function
Function data_ChangeQuality(Period, Year As String)
Dim PeriodID, assignmentgroupid, Excellent, Acceptable, Poor As Long
Dim dbs, rst, rst2, qdfnew, qdfnew2
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
'Create Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_ChangeQuality", _
"SELECT tbAssignmentGroups.AssignmentID, dbo_cm3rm1.close_time, dbo_cm3rm2.tec_overall_quality, dbo_cm3rm1.number " & _
"FROM (dbo_cm3rm1 INNER JOIN dbo_cm3rm2 ON dbo_cm3rm1.number = dbo_cm3rm2.number) LEFT JOIN tbAssignmentGroups ON dbo_cm3rm1.request_dept = tbAssignmentGroups.Name " & _
"WHERE (((dbo_cm3rm1.close_time)>=#" & returnPeriodStart(Period, Year) & "# And (dbo_cm3rm1.close_time) <= #" & returnPeriodEnd(Period, Year) & "#)) AND (Not (dbo_cm3rm1.completion_code)=6);")
Set qdfnew2 = dbs.CreateQueryDef("Temp_ChangeQuality_CrossTab ", _
"TRANSFORM Count(Temp_ChangeQuality.close_time) AS [The Value] " & _
"SELECT Temp_ChangeQuality.AssignmentID, Count(Temp_ChangeQuality.number) AS CountOfnumber " & _
"FROM Temp_ChangeQuality " & _
"GROUP BY Temp_ChangeQuality.AssignmentID " & _
"PIVOT ""Data_"" & Temp_ChangeQuality.tec_overall_quality;")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_ChangeQuality_CrossTab", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_Data_Change_Quality", dbOpenDynaset)
Excellent = 0
Acceptable = 0
Poor = 0
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!Data_1) Then Excellent = 0 Else Excellent = !Data_1
If IsNull(!data_2) Then Acceptable = 0 Else Acceptable = !data_2
If IsNull(!data_3) Then Poor = 0 Else Poor = !data_3
On Error GoTo 0
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_excellent = Excellent
!data_acceptable = Acceptable
!data_poor = Poor
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then assignmentgroupid = 1 ' 1 = Unknown Group
On Error Resume Next
If IsNull(!Data_1) Then Excellent = 0 Else Excellent = !Data_1
If IsNull(!data_2) Then Acceptable = 0 Else Acceptable = !data_2
If IsNull(!data_3) Then Poor = 0 Else Poor = !data_3
On Error GoTo 0
End If
End With
Loop
rst.Close
rst2.Close
'Delete Query Definition
dbs.QueryDefs.Delete qdfnew.Name
dbs.QueryDefs.Delete qdfnew2.Name
'Update Blanks from Query
DoCmd.OpenQuery ("Qy_UpdateBlanks_ChangeQuality")
dbs.Close
End Function
boblarson
Smeghead
- Local time
- Yesterday, 20:45
- Joined
- Jan 12, 2001
- Messages
- 32,059
Disable any On Error... code and it should give you the dialog which includes the Debug button and then it will take you to the code that has the problem.
