Go Back   Access World Forums > Microsoft Access Discussion > Modules & VBA

 
Reply
 
Thread Tools Rating: Thread Rating: 43 votes, 5.00 average. Display Modes
Old 06-30-2008, 03:48 AM   #1
puskardas
Registered User
 
Join Date: Jun 2008
Posts: 6
Thanks: 0
Thanked 0 Times in 0 Posts
puskardas is on a distinguished road
Run time error 3075 - syntax error (missing operator) in query expression

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.

Attached Files
File Type: zip Code.zip (9.6 KB, 207 views)

puskardas is offline   Reply With Quote
Old 06-30-2008, 07:59 AM   #2
pbaldy
Wino Moderator
 
pbaldy's Avatar
 
Join Date: Aug 2003
Location: Nevada, USA
Posts: 33,051
Thanks: 13
Thanked 4,066 Times in 4,001 Posts
pbaldy is a splendid one to behold pbaldy is a splendid one to behold pbaldy is a splendid one to behold pbaldy is a splendid one to behold pbaldy is a splendid one to behold pbaldy is a splendid one to behold pbaldy is a splendid one to behold
I get an error trying to extract the zip file. Either try again or post the code here.
__________________
Paul
Microsoft Access MVP 2007-2019

To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
pbaldy is offline   Reply With Quote
Old 06-30-2008, 08:55 AM   #3
WayneRyan
AWF VIP
 
Join Date: Nov 2002
Location: Camarillo, CA
Posts: 7,090
Thanks: 6
Thanked 57 Times in 55 Posts
WayneRyan is a jewel in the rough WayneRyan is a jewel in the rough WayneRyan is a jewel in the rough
p,

For Starters:

Change --> SELECT IIF(dbo_probsummarym1.assignment IS NULL

To --> SELECT IIF(IsNull(dbo_probsummarym1.assignment)

Also, try the same syntax in the Group By clause.

Wayne

WayneRyan is offline   Reply With Quote
Old 06-30-2008, 06:24 PM   #4
puskardas
Registered User
 
Join Date: Jun 2008
Posts: 6
Thanks: 0
Thanked 0 Times in 0 Posts
puskardas is on a distinguished road
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_ActiveAssignment s", 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
puskardas is offline   Reply With Quote
Old 06-30-2008, 06:27 PM   #5
puskardas
Registered User
 
Join Date: Jun 2008
Posts: 6
Thanks: 0
Thanked 0 Times in 0 Posts
puskardas is on a distinguished road
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
puskardas is offline   Reply With Quote
Old 06-30-2008, 06:28 PM   #6
puskardas
Registered User
 
Join Date: Jun 2008
Posts: 6
Thanks: 0
Thanked 0 Times in 0 Posts
puskardas is on a distinguished road
'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
puskardas is offline   Reply With Quote
Old 06-30-2008, 06:32 PM   #7
puskardas
Registered User
 
Join Date: Jun 2008
Posts: 6
Thanks: 0
Thanked 0 Times in 0 Posts
puskardas is on a distinguished road
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

puskardas is offline   Reply With Quote
Old 06-30-2008, 06:33 PM   #8
puskardas
Registered User
 
Join Date: Jun 2008
Posts: 6
Thanks: 0
Thanked 0 Times in 0 Posts
puskardas is on a distinguished road
unfortunately the code is too big .
puskardas is offline   Reply With Quote
Old 06-30-2008, 07:35 PM   #9
boblarson
Smeghead
 
boblarson's Avatar
 
Join Date: Jan 2001
Location: Oregon, USA
Posts: 32,068
Thanks: 97
Thanked 1,825 Times in 1,578 Posts
boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold
Quote:
Originally Posted by puskardas View Post
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.
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.

__________________

To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
boblarson is offline   Reply With Quote
Reply

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Need query to calculate on time deliveries as a percent cturton Queries 2 03-13-2006 04:01 PM
[SOLVED] short time not working in make table query nelld General 1 03-08-2006 08:31 PM
filter query returns same value every time!! dajabo Queries 3 01-31-2005 05:42 AM
Run a Query at a specific time yahazim Queries 2 01-29-2002 04:34 PM




All times are GMT -8. The time now is 12:03 AM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post


Sponsored Links


Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World