Trygve Thayer
asked on
VB Code to mark table for Employee Attendance
Database to keep records of employees attendance.
Table called..... tblOccurrence
Fields..........Occurrence ID Auto Number
...................Employe e Text
...................Date Date/Time
...................[Occurr ence Value] Long Integer
...................[Occurr ence Type] Text
...................[Occurr ence Comments] Text
...................[Occurr ence Dropped] Yes/No
...................[Occurr ence Reference] Yes/No
Task
1. Check all records from the current date and mark the ones that are older than 1 year
2. Check all records in the current year and starting with the earliest date see if there is a span of more than 4 months
IF
a span of 4 months is found and there are no records within the current year marked [Occurrence Reference]
then mark the oldest record in the current year as dropped and mark the record the 4 month span was found.
Ex. If the date is 4/13/2004 and there are records of 4/15/2003, 5/15/2003, 8/11/2003,12/11/2003, and
4/11/2004 in the current year then there is a 4 month span between 8/11/2003 and 12/11/2003. The
4/15/2003 should be marked as [Occurrence Dropped] and 12/11/2003 should be marked as
[Occurrence Reference]
Else
a span of 4 months is found and there are records found within the current year marked [Occurrence Reference]
then select all records in the current year from the latest record marked [Occurrence Reference] to the current
date. Recheck to see if there is a span of 4 months with no records. If there is then mark the oldest record in
the active year (1 year back) that is not marked as [Occurrence Dropped] and mark the 4 month span that was
found. Ex. If the date is 4/13/2004 and there are records of 4/15/2003, 5/15/2003, 8/11/2003,12/11/2003,
and 4/11/2004 in the current year and 4/15/2003 is marked as [Occurrence Dropped] and 8/11/2003 is marked
[Occurrence Reference] then there is a 4 month span between 12/11/2003 and 4/11/2004. The
5/15/2003 should be marked as [Occurrence Dropped] and 4/11/2004 should be marked as
[Occurrence Reference]
Table called..... tblOccurrence
Fields..........Occurrence
...................Employe
...................Date Date/Time
...................[Occurr
...................[Occurr
...................[Occurr
...................[Occurr
...................[Occurr
Task
1. Check all records from the current date and mark the ones that are older than 1 year
2. Check all records in the current year and starting with the earliest date see if there is a span of more than 4 months
IF
a span of 4 months is found and there are no records within the current year marked [Occurrence Reference]
then mark the oldest record in the current year as dropped and mark the record the 4 month span was found.
Ex. If the date is 4/13/2004 and there are records of 4/15/2003, 5/15/2003, 8/11/2003,12/11/2003, and
4/11/2004 in the current year then there is a 4 month span between 8/11/2003 and 12/11/2003. The
4/15/2003 should be marked as [Occurrence Dropped] and 12/11/2003 should be marked as
[Occurrence Reference]
Else
a span of 4 months is found and there are records found within the current year marked [Occurrence Reference]
then select all records in the current year from the latest record marked [Occurrence Reference] to the current
date. Recheck to see if there is a span of 4 months with no records. If there is then mark the oldest record in
the active year (1 year back) that is not marked as [Occurrence Dropped] and mark the 4 month span that was
found. Ex. If the date is 4/13/2004 and there are records of 4/15/2003, 5/15/2003, 8/11/2003,12/11/2003,
and 4/11/2004 in the current year and 4/15/2003 is marked as [Occurrence Dropped] and 8/11/2003 is marked
[Occurrence Reference] then there is a 4 month span between 12/11/2003 and 4/11/2004. The
5/15/2003 should be marked as [Occurrence Dropped] and 4/11/2004 should be marked as
[Occurrence Reference]
ASKER
I will do what ever you recommend as I am truely a novice with an HR manager expecting results. My forte is in networking and not in databases. Being short staffed here I am now going to heve to get up to speed on databases. Thank goodness for the experts here to help me through.
Hi Ty,
Need some clarification on this bit mate.
I dont need you to re-write it, just define the bits in question, just about got it memorised,
if you re-write it I'm back where I started from trying to get my head around this logic :)
2. Check all records in the current year and starting with the earliest date see if there is a span of more than 4 months
IF
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
Definitions:
Current Year = Every record for one given Employee between TodaysDate and (Todaysdate - 1 year)
aka (ActiveSet)
Current Year = Every record for one given Employee that is not marked dropped
(all recs > 1yr old are dropped prior to running this script)
Clarify this:
' and mark the record the 4 month span was found
what do I mark?
Define: 'the record'
Suppose I find two records with a datediff > 4 months 1-aug-2003 and 2-dec-2003 which one do I mark
and which field am I marking [Occurrence Reference] or [Occurrence Dropped]
Notes:
The rule about only having a maximum of 3 [Occurrence Dropped] as a reward for perfect attendance in any given year, can only be attained if we check for datediff => 4 months instead of datediff > 4 months
The Attendance Policy Document seems less complex than this:
If perfect attendance is achieved (4 months without an occurence) Then
find the oldest occurence for that employee that is not marked as dropped
and mark it as dropped, (all recs > 1yr old are dropped prior to running this script)
End If
Occurence Reference field may not be needed at all...
Alan
Need some clarification on this bit mate.
I dont need you to re-write it, just define the bits in question, just about got it memorised,
if you re-write it I'm back where I started from trying to get my head around this logic :)
2. Check all records in the current year and starting with the earliest date see if there is a span of more than 4 months
IF
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
Definitions:
Current Year = Every record for one given Employee between TodaysDate and (Todaysdate - 1 year)
aka (ActiveSet)
Current Year = Every record for one given Employee that is not marked dropped
(all recs > 1yr old are dropped prior to running this script)
Clarify this:
' and mark the record the 4 month span was found
what do I mark?
Define: 'the record'
Suppose I find two records with a datediff > 4 months 1-aug-2003 and 2-dec-2003 which one do I mark
and which field am I marking [Occurrence Reference] or [Occurrence Dropped]
Notes:
The rule about only having a maximum of 3 [Occurrence Dropped] as a reward for perfect attendance in any given year, can only be attained if we check for datediff => 4 months instead of datediff > 4 months
The Attendance Policy Document seems less complex than this:
If perfect attendance is achieved (4 months without an occurence) Then
find the oldest occurence for that employee that is not marked as dropped
and mark it as dropped, (all recs > 1yr old are dropped prior to running this script)
End If
Occurence Reference field may not be needed at all...
Alan
Hi Ty,
Sorry I didn't get this done last night, stuff happens.
Got no problem finding qualifying occurences with the correct datediff - done
This where I am up to:
Clarification requested above pertains to this point in code:
' Found between OccurrenceID 23 and OccurrenceID 23
Stop
Private Sub Command13_Click()
On Error GoTo ReportError
Dim strSQL As String
Dim strWhere As String
Dim strFilesChecked As String ' InClause for sql where condition
' (records to exclude on next loop of active set)
Dim recOccurrence As ADODB.Recordset
Dim recEmployee As ADODB.Recordset
Dim dNextNewestDate As Date
Dim dNextOldestDate As Date
Dim lNextOldestID As Long
Dim lNextNewestID As Long
' 1. -The update should check all records and mark the field
' [Occurrence Dropped] if the records are older than 1 year.
strSQL = "UPDATE tblOccurrence SET tblOccurrence.[Occurrence Dropped] = True"
strSQL = strSQL & " WHERE [Date] <=DateAdd('yyyy',-1,Now()) "
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'2. Check all records in the current year and starting with the earliest date
' see if there is a span of more than 4 months
Set recOccurrence = New ADODB.Recordset
Set recEmployee = New ADODB.Recordset
strSQL = "SELECT Distinct tblOccurrence.Employee FROM tblOccurrence"
recEmployee.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
With recEmployee
.MoveFirst
Do While Not .BOF And Not .EOF
Do
' open the active set for this employee
strSQL = "SELECT OccurrenceID, Employee, [Date], [Occurrence Dropped], [Occurrence Reference] FROM tblOccurrence"
strSQL = strSQL & " WHERE Employee='" & .Fields("Employee")
strSQL = strSQL & "' AND [Occurrence Dropped]=False"
' Exclude ID's in this active set that we have already checked
If strFilesChecked <> "" Then
strSQL = strSQL & " AND OccurrenceID Not IN(" & Left(strFilesChecked, Len(strFilesChecked) - 1) & ")"
End If
strSQL = strSQL & " Order By Date Asc"
recOccurrence.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
With recOccurrence
.MoveFirst
If Not .BOF And Not .EOF Then
lNextOldestID = .Fields("OccurrenceID")
dNextOldestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
.MoveNext
lNextNewestID = .Fields("OccurrenceID")
dNextNewestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
If dNextOldestDate < DateAdd("m", -4, dNextNewestDate) Then
' a span of 4 months has been found
' Found between OccurrenceID 23 and OccurrenceID 23
Stop
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
' Of the two records we are comparing, which record gets marked as
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
' ========================== ========== ======
' Code to mark the oldest occurence, in current year, not marked as dropped,
' for this employee goes here.
'
' ========================== ========== ======
Else
' Add the ID of this record to strFilesChecked(List of records to exclude on next loop)
strFilesChecked = strFilesChecked & .Fields("OccurrenceID") & ","
End If
End If
.Close
End With
Loop
.MoveNext
Loop
End With
ExitProcedure:
On Error Resume Next
Set recOccurrence = Nothing
Set recEmployee = Nothing
Exit Sub
ReportError:
Dim msg As String
' Modify the following to return correct Form Name and Procedure Name ********
msg = "Error in Form1_Command11_Click():" _
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
Alan
Sorry I didn't get this done last night, stuff happens.
Got no problem finding qualifying occurences with the correct datediff - done
This where I am up to:
Clarification requested above pertains to this point in code:
' Found between OccurrenceID 23 and OccurrenceID 23
Stop
Private Sub Command13_Click()
On Error GoTo ReportError
Dim strSQL As String
Dim strWhere As String
Dim strFilesChecked As String ' InClause for sql where condition
' (records to exclude on next loop of active set)
Dim recOccurrence As ADODB.Recordset
Dim recEmployee As ADODB.Recordset
Dim dNextNewestDate As Date
Dim dNextOldestDate As Date
Dim lNextOldestID As Long
Dim lNextNewestID As Long
' 1. -The update should check all records and mark the field
' [Occurrence Dropped] if the records are older than 1 year.
strSQL = "UPDATE tblOccurrence SET tblOccurrence.[Occurrence Dropped] = True"
strSQL = strSQL & " WHERE [Date] <=DateAdd('yyyy',-1,Now())
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'2. Check all records in the current year and starting with the earliest date
' see if there is a span of more than 4 months
Set recOccurrence = New ADODB.Recordset
Set recEmployee = New ADODB.Recordset
strSQL = "SELECT Distinct tblOccurrence.Employee FROM tblOccurrence"
recEmployee.Open strSQL, CurrentProject.Connection,
With recEmployee
.MoveFirst
Do While Not .BOF And Not .EOF
Do
' open the active set for this employee
strSQL = "SELECT OccurrenceID, Employee, [Date], [Occurrence Dropped], [Occurrence Reference] FROM tblOccurrence"
strSQL = strSQL & " WHERE Employee='" & .Fields("Employee")
strSQL = strSQL & "' AND [Occurrence Dropped]=False"
' Exclude ID's in this active set that we have already checked
If strFilesChecked <> "" Then
strSQL = strSQL & " AND OccurrenceID Not IN(" & Left(strFilesChecked, Len(strFilesChecked) - 1) & ")"
End If
strSQL = strSQL & " Order By Date Asc"
recOccurrence.Open strSQL, CurrentProject.Connection,
With recOccurrence
.MoveFirst
If Not .BOF And Not .EOF Then
lNextOldestID = .Fields("OccurrenceID")
dNextOldestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
.MoveNext
lNextNewestID = .Fields("OccurrenceID")
dNextNewestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
If dNextOldestDate < DateAdd("m", -4, dNextNewestDate) Then
' a span of 4 months has been found
' Found between OccurrenceID 23 and OccurrenceID 23
Stop
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
' Of the two records we are comparing, which record gets marked as
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
' ==========================
' Code to mark the oldest occurence, in current year, not marked as dropped,
' for this employee goes here.
'
' ==========================
Else
' Add the ID of this record to strFilesChecked(List of records to exclude on next loop)
strFilesChecked = strFilesChecked & .Fields("OccurrenceID") & ","
End If
End If
.Close
End With
Loop
.MoveNext
Loop
End With
ExitProcedure:
On Error Resume Next
Set recOccurrence = Nothing
Set recEmployee = Nothing
Exit Sub
ReportError:
Dim msg As String
' Modify the following to return correct Form Name and Procedure Name ********
msg = "Error in Form1_Command11_Click():" _
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
Alan
ASKER
allenwarren......
I pasted the code in and ran it. From your comments I understood you still had some work to do on it. I just wanted to see where it got. It marked records as [Occurrence Dropped] but went in error which is what I guess you are still working on. The code is below where I got the error.
If Not .BOF And Not .EOF Then
lNextOldestID = .Fields("OccurrenceID")
dNextOldestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
.MoveNext
lNextNewestID = .Fields("OccurrenceID")
dNextNewestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
If dNextOldestDate < DateAdd("m", -4, dNextNewestDate) Then
' a span of 4 months has been found
' Found between OccurrenceID 23 and OccurrenceID 23
***** Stop
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
' Of the two records we are comparing, which record gets marked as
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
I pasted the code in and ran it. From your comments I understood you still had some work to do on it. I just wanted to see where it got. It marked records as [Occurrence Dropped] but went in error which is what I guess you are still working on. The code is below where I got the error.
If Not .BOF And Not .EOF Then
lNextOldestID = .Fields("OccurrenceID")
dNextOldestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
.MoveNext
lNextNewestID = .Fields("OccurrenceID")
dNextNewestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
If dNextOldestDate < DateAdd("m", -4, dNextNewestDate) Then
' a span of 4 months has been found
' Found between OccurrenceID 23 and OccurrenceID 23
***** Stop
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
' Of the two records we are comparing, which record gets marked as
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
ASKER
alanwarren.....
Just catching up and read some of your previous posts indicating the [Occurrence Reference] field might not be needed. That works for me. I could just not visualize how to describe it.
Also your comments from below referencing the attendance policy. If in the sample data 4/15/2003 is marked dropped and it is dropped as a result of the 4 months between 8/11/2003 and 12/11/2003. then is it possible there can be a 4 month period of good attendance that doesn't quality. I am thinking that if the update has not been ran daily the situation could exist. which could cause more than 3 records to be dropped in 1 years time. Don't know that for sure.
If perfect attendance is achieved (4 months without an occurence) Then
find the oldest occurence for that employee that is not marked as dropped
and mark it as dropped, (all recs > 1yr old are dropped prior to running this script)
and there are records of 4/15/2003, 5/15/2003, 8/11/2003,12/11/2003, and
4/11/2004 in the current year
Just catching up and read some of your previous posts indicating the [Occurrence Reference] field might not be needed. That works for me. I could just not visualize how to describe it.
Also your comments from below referencing the attendance policy. If in the sample data 4/15/2003 is marked dropped and it is dropped as a result of the 4 months between 8/11/2003 and 12/11/2003. then is it possible there can be a 4 month period of good attendance that doesn't quality. I am thinking that if the update has not been ran daily the situation could exist. which could cause more than 3 records to be dropped in 1 years time. Don't know that for sure.
If perfect attendance is achieved (4 months without an occurence) Then
find the oldest occurence for that employee that is not marked as dropped
and mark it as dropped, (all recs > 1yr old are dropped prior to running this script)
and there are records of 4/15/2003, 5/15/2003, 8/11/2003,12/11/2003, and
4/11/2004 in the current year
G'Day Ty,
' pick up thought here:
Stop
' then mark the oldest record in the current year as dropped ------ Now Completed
' and mark the record the 4 month span was found. ------- huh???
' Of the two records we are comparing, which record gets marked as what
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
Alan :)
' pick up thought here:
Stop
' then mark the oldest record in the current year as dropped ------ Now Completed
' and mark the record the 4 month span was found. ------- huh???
' Of the two records we are comparing, which record gets marked as what
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
Alan :)
I think it should be:
Mark Fields("Occurrence Reference") = true for dNextNewestDate field
Choose between the two date we are comparing
The only reason I see for keeping Fields("Occurrence Reference") is so you can later query the records to report that because on this date Where Fields("Occurrence Reference") = true
that the employee was granted a reward for perfect attendance
the reward being one of his/here blemishes has been removed from his/her history.
Alan
ASKER
As long as it works I am happy. Have to go to a neighbors hose to fix their computer. I guess I am the subdivisions technician. Be back in 30 minutes.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
AllenWarren......
Got your post. I have just been paged to take care of a network issue as a result of a power loss. It is 9:50pm here. I will be back in 3 hours and let you know how it works. Thanks in advance for all your help.
Got your post. I have just been paged to take care of a network issue as a result of a power loss. It is 9:50pm here. I will be back in 3 hours and let you know how it works. Thanks in advance for all your help.
ASKER
allenwarren.........
The 3 hours turned into almost an all nighter. Tried your code this morning (your night) and it works exactly as expected. Thanks so much for your help. I will continue on developing the logistics of this database as occurrences are only one part. I still have overtime and vacation to go but they are within my abilities (I think) If not, you will see me again (probably the case).
P.S. Saw your ad for contract support. Send me your requirements to tthayer@vacumet.com There is nothing at the time but with projected goals for our department we might be able to work something out after October which is when budgets are reviewed. We usually have a little left over and using it to get us off these aggrivating (macro intensive) Lotus Approach databases would be well worth managements consideration.
The 3 hours turned into almost an all nighter. Tried your code this morning (your night) and it works exactly as expected. Thanks so much for your help. I will continue on developing the logistics of this database as occurrences are only one part. I still have overtime and vacation to go but they are within my abilities (I think) If not, you will see me again (probably the case).
P.S. Saw your ad for contract support. Send me your requirements to tthayer@vacumet.com There is nothing at the time but with projected goals for our department we might be able to work something out after October which is when budgets are reviewed. We usually have a little left over and using it to get us off these aggrivating (macro intensive) Lotus Approach databases would be well worth managements consideration.
ASKER
allenwarren......testing found vb error messages.
The only records I had in our test data was for Trygve Thayer. In doing some more testing I have added 1 more record which is a different employee. It gives me this error message.
Error in frmOccurrenceCommand11_Cli ck(): Error number 3705 was generated by ADODB.Recordset. Operation is not allowed when the object is open.
The only records I had in our test data was for Trygve Thayer. In doing some more testing I have added 1 more record which is a different employee. It gives me this error message.
Error in frmOccurrenceCommand11_Cli
will check into it shortly mate...
oops!
had no Exit Do for recEmployee
Alan
Private Sub Command13_Click()
On Error GoTo ReportError
Dim strSQL As String
Dim strWhere As String
Dim strFilesChecked As String ' InClause for sql where condition
' (records to exclude on next loop of active set)
Dim recOccurrence As ADODB.Recordset
Dim recEmployee As ADODB.Recordset
Dim dNextNewestDate As Date
Dim dNextOldestDate As Date
Dim lNextOldestID As Long
Dim lNextNewestID As Long
Dim lRecordChecked As Long
' 1. -The update should check all records and mark the field
' [Occurrence Dropped] if the records are older than 1 year.
strSQL = "UPDATE tblOccurrence SET tblOccurrence.[Occurrence Dropped] = True"
strSQL = strSQL & " WHERE [Date] <=DateAdd('yyyy',-1,Now())
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'2. Check all records in the current year and starting with the earliest date
' see if there is a span of more than 4 months
Set recOccurrence = New ADODB.Recordset
Set recEmployee = New ADODB.Recordset
strSQL = "SELECT Distinct tblOccurrence.Employee FROM tblOccurrence"
recEmployee.Open strSQL, CurrentProject.Connection,
With recEmployee
.MoveFirst
Do While Not .BOF And Not .EOF
Do
' open the active set for this employee
strSQL = "SELECT OccurrenceID, Employee, [Date], [Occurrence Dropped], [Occurrence Reference] FROM tblOccurrence"
strSQL = strSQL & " WHERE Employee='" & .Fields("Employee")
strSQL = strSQL & "' AND [Occurrence Dropped]=False AND [Occurrence Reference]=False"
' Exclude ID's in this active set that we have already checked
If strFilesChecked <> "" Then
strSQL = strSQL & " AND OccurrenceID Not IN(" & Left(strFilesChecked, Len(strFilesChecked) - 1) & ")"
End If
strSQL = strSQL & " Order By Date Asc"
recOccurrence.Open strSQL, CurrentProject.Connection,
With recOccurrence
' .MoveFirst ' <-- aw 15-apr-2004 moved this down 2 lines
If Not .BOF And Not .EOF Then
.MoveFirst ' <-- aw 15-apr-2004 modified positon of this line
lNextOldestID = .Fields("OccurrenceID")
lRecordChecked = lNextOldestID
dNextOldestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
.MoveNext
If .EOF Then: Exit Do
lNextNewestID = .Fields("OccurrenceID")
dNextNewestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
If dNextOldestDate <= DateAdd("m", -4, dNextNewestDate) Then
' a span of 4 months has been found
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
' Of the two records we are comparing, which record gets marked as
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
' ==========================
' Code to mark the oldest occurence, in current year, not marked as dropped,
' for this employee goes here.
'
' note: Get the ID of oldest record not dropped for this Employee
' Then run some sql here to mark as dropped and re-populate the variable
' ==========================
strFilesChecked = strFilesChecked & .Fields("OccurrenceID") & ","
Dim lOldestOffenceID As Long
lOldestOffenceID = getOldestActiveOffenceID(.
Call doMarkOldestActiveOffenceI
Call doMarkOccurencReference(lN
Else
' Add the ID of this record to strFilesChecked(List of records to exclude on next loop)
strFilesChecked = strFilesChecked & lRecordChecked & ","
End If
Else '<-- aw 15-apr-2004 Added the Else to get out of the inner loop if .BOF and .EOF
.Close
Exit Do
End If
.Close
End With
Loop
strFilesChecked = ""
.MoveNext
Loop
End With
ExitProcedure:
On Error Resume Next
Set recOccurrence = Nothing
Set recEmployee = Nothing
Exit Sub
ReportError:
Dim msg As String
msg = "Error in " & Me.Name & "Command11_Click():" _
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
ASKER
allenwarren......
Still getting same error but attempted looking through it and think I found it but before I try changing it I wanted to run it by you. I have marked it at the bottom with *****
Private Sub Command13_Click()
On Error GoTo ReportError
Dim strSQL As String
Dim strWhere As String
Dim strFilesChecked As String ' InClause for sql where condition
' (records to exclude on next loop of active set)
Dim recOccurrence As ADODB.Recordset
Dim recEmployee As ADODB.Recordset
Dim dNextNewestDate As Date
Dim dNextOldestDate As Date
Dim lNextOldestID As Long
Dim lNextNewestID As Long
Dim lRecordChecked As Long
' 1. -The update should check all records and mark the field
' [Occurrence Dropped] if the records are older than 1 year.
strSQL = "UPDATE tblOccurrence SET tblOccurrence.[Occurrence Dropped] = True"
strSQL = strSQL & " WHERE [Date] <=DateAdd('yyyy',-1,Now()) "
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'2. Check all records in the current year and starting with the earliest date
' see if there is a span of more than 4 months
Set recOccurrence = New ADODB.Recordset
Set recEmployee = New ADODB.Recordset
strSQL = "SELECT Distinct tblOccurrence.Employee FROM tblOccurrence"
recEmployee.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
With recEmployee
.MoveFirst
Do While Not .BOF And Not .EOF
Do
' open the active set for this employee
strSQL = "SELECT OccurrenceID, Employee, [Date], [Occurrence Dropped], [Occurrence Reference] FROM tblOccurrence"
strSQL = strSQL & " WHERE Employee='" & .Fields("Employee")
strSQL = strSQL & "' AND [Occurrence Dropped]=False AND [Occurrence Reference]=False"
' Exclude ID's in this active set that we have already checked
If strFilesChecked <> "" Then
strSQL = strSQL & " AND OccurrenceID Not IN(" & Left(strFilesChecked, Len(strFilesChecked) - 1) & ")"
End If
strSQL = strSQL & " Order By Date Asc"
recOccurrence.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
With recOccurrence
' .MoveFirst ' <-- aw 15-apr-2004 moved this down 2 lines
If Not .BOF And Not .EOF Then
.MoveFirst ' <-- aw 15-apr-2004 modified positon of this line
lNextOldestID = .Fields("OccurrenceID")
lRecordChecked = lNextOldestID
dNextOldestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
.MoveNext
If .EOF Then: Exit Do
lNextNewestID = .Fields("OccurrenceID")
dNextNewestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
If dNextOldestDate <= DateAdd("m", -4, dNextNewestDate) Then
' a span of 4 months has been found
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
' Of the two records we are comparing, which record gets marked as
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
' ========================== ========== ======
' Code to mark the oldest occurence, in current year, not marked as dropped,
' for this employee goes here.
'
' note: Get the ID of oldest record not dropped for this Employee
' Then run some sql here to mark as dropped and re-populate the variable
' ========================== ========== ======
strFilesChecked = strFilesChecked & .Fields("OccurrenceID") & ","
Dim lOldestOffenceID As Long
lOldestOffenceID = getOldestActiveOffenceID(. Fields("Em ployee"))
Call doMarkOldestActiveOffenceI D(lOldestO ffenceID)
Call doMarkOccurencReference(lN extNewestI D)
Else
' Add the ID of this record to strFilesChecked(List of records to exclude on next loop)
strFilesChecked = strFilesChecked & lRecordChecked & ","
End If
Else '<-- aw 15-apr-2004 Added the Else to get out of the inner loop if .BOF and .EOF
.Close
Exit Do
End If
.Close
End With
Loop
strFilesChecked = ""
.MoveNext
Loop
End With
ExitProcedure:
On Error Resume Next
Set recOccurrence = Nothing
Set recEmployee = Nothing
Exit Sub
ReportError:
Dim msg As String
************* msg = "Error in " & Me.Name & "Command11_Click():" _
********should the line above be Command13_Click():" ?
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
Still getting same error but attempted looking through it and think I found it but before I try changing it I wanted to run it by you. I have marked it at the bottom with *****
Private Sub Command13_Click()
On Error GoTo ReportError
Dim strSQL As String
Dim strWhere As String
Dim strFilesChecked As String ' InClause for sql where condition
' (records to exclude on next loop of active set)
Dim recOccurrence As ADODB.Recordset
Dim recEmployee As ADODB.Recordset
Dim dNextNewestDate As Date
Dim dNextOldestDate As Date
Dim lNextOldestID As Long
Dim lNextNewestID As Long
Dim lRecordChecked As Long
' 1. -The update should check all records and mark the field
' [Occurrence Dropped] if the records are older than 1 year.
strSQL = "UPDATE tblOccurrence SET tblOccurrence.[Occurrence Dropped] = True"
strSQL = strSQL & " WHERE [Date] <=DateAdd('yyyy',-1,Now())
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'2. Check all records in the current year and starting with the earliest date
' see if there is a span of more than 4 months
Set recOccurrence = New ADODB.Recordset
Set recEmployee = New ADODB.Recordset
strSQL = "SELECT Distinct tblOccurrence.Employee FROM tblOccurrence"
recEmployee.Open strSQL, CurrentProject.Connection,
With recEmployee
.MoveFirst
Do While Not .BOF And Not .EOF
Do
' open the active set for this employee
strSQL = "SELECT OccurrenceID, Employee, [Date], [Occurrence Dropped], [Occurrence Reference] FROM tblOccurrence"
strSQL = strSQL & " WHERE Employee='" & .Fields("Employee")
strSQL = strSQL & "' AND [Occurrence Dropped]=False AND [Occurrence Reference]=False"
' Exclude ID's in this active set that we have already checked
If strFilesChecked <> "" Then
strSQL = strSQL & " AND OccurrenceID Not IN(" & Left(strFilesChecked, Len(strFilesChecked) - 1) & ")"
End If
strSQL = strSQL & " Order By Date Asc"
recOccurrence.Open strSQL, CurrentProject.Connection,
With recOccurrence
' .MoveFirst ' <-- aw 15-apr-2004 moved this down 2 lines
If Not .BOF And Not .EOF Then
.MoveFirst ' <-- aw 15-apr-2004 modified positon of this line
lNextOldestID = .Fields("OccurrenceID")
lRecordChecked = lNextOldestID
dNextOldestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
.MoveNext
If .EOF Then: Exit Do
lNextNewestID = .Fields("OccurrenceID")
dNextNewestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
If dNextOldestDate <= DateAdd("m", -4, dNextNewestDate) Then
' a span of 4 months has been found
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
' Of the two records we are comparing, which record gets marked as
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
' ==========================
' Code to mark the oldest occurence, in current year, not marked as dropped,
' for this employee goes here.
'
' note: Get the ID of oldest record not dropped for this Employee
' Then run some sql here to mark as dropped and re-populate the variable
' ==========================
strFilesChecked = strFilesChecked & .Fields("OccurrenceID") & ","
Dim lOldestOffenceID As Long
lOldestOffenceID = getOldestActiveOffenceID(.
Call doMarkOldestActiveOffenceI
Call doMarkOccurencReference(lN
Else
' Add the ID of this record to strFilesChecked(List of records to exclude on next loop)
strFilesChecked = strFilesChecked & lRecordChecked & ","
End If
Else '<-- aw 15-apr-2004 Added the Else to get out of the inner loop if .BOF and .EOF
.Close
Exit Do
End If
.Close
End With
Loop
strFilesChecked = ""
.MoveNext
Loop
End With
ExitProcedure:
On Error Resume Next
Set recOccurrence = Nothing
Set recEmployee = Nothing
Exit Sub
ReportError:
Dim msg As String
************* msg = "Error in " & Me.Name & "Command11_Click():" _
********should the line above be Command13_Click():" ?
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
Hi
no thats not the problem, you could type anything in there, it is just a string,
but it should have the name of your button in there
Do you get a compile error?
In any code window Menu > Debug > Compile
Alan
no thats not the problem, you could type anything in there, it is just a string,
but it should have the name of your button in there
Do you get a compile error?
In any code window Menu > Debug > Compile
Alan
ASKER
Well that was not it. I went and tried it anyway but still get same error.
Hi mate,
mine seems to be working as expected.
OccurrenceID Employee Date Occurrence Value Occurrence Type Occurrence Comments Occurrence Dropped Occurrence Reference
1 Thayer, Trygve 10-Apr-2003 2 Call In yep he did it. Yes No
5 Thayer, Trygve 30-Mar-2002 2 Call In Yes No
6 Thayer, Trygve 01-Jan-2001 2 Call In tttt Yes No
7 Thayer, Trygve 01-Jan-2001 2 Call In eeee Yes No
8 Thayer, Trygve 01-Jan-2002 1 Call In wwww Yes No
9 Thayer, Trygve 01-Jan-2003 1 Call In rrrr Yes No
10 Thayer, Trygve 02-Jan-1998 1 Call In Yes No
11 Thayer, Trygve 02-Jan-1999 1 Call In Yes No
12 Thayer, Trygve 02-Jan-2000 2 Call In Yes No
13 Thayer, Trygve 02-Jan-2001 1 Call In Yes No
14 Thayer, Trygve 02-Jan-2002 1 Call In Yes No
15 Thayer, Trygve 01-Feb-2003 1 Call In Yes No
16 Thayer, Trygve 01-Mar-2003 1 Call In Yes No
17 Thayer, Trygve 01-Apr-2003 1 Call In Yes No
18 Thayer, Trygve 15-May-2003 2 Over 2 Yes No
19 Thayer, Trygve 11-Aug-2003 1 Over 2 Yes No
23 Thayer, Trygve 11-Dec-2003 2 Call In No Yes
25 Thayer, Trygve 15-Apr-2003 1 Call In Yes No
27 Thayer, Trygve 12-Apr-2004 2 Call In No Yes
28 Warren, Alan 15-May-2003 2 Over 2 Yes No
29 Warren, Alan 11-Aug-2003 1 Over 2 Yes No
30 Warren, Alan 11-Dec-2003 2 Call In No Yes
31 Warren, Alan 15-Apr-2003 1 Call In Yes No
32 Warren, Alan 12-Apr-2004 2 Call In No Yes
Alan
mine seems to be working as expected.
OccurrenceID Employee Date Occurrence Value Occurrence Type Occurrence Comments Occurrence Dropped Occurrence Reference
1 Thayer, Trygve 10-Apr-2003 2 Call In yep he did it. Yes No
5 Thayer, Trygve 30-Mar-2002 2 Call In Yes No
6 Thayer, Trygve 01-Jan-2001 2 Call In tttt Yes No
7 Thayer, Trygve 01-Jan-2001 2 Call In eeee Yes No
8 Thayer, Trygve 01-Jan-2002 1 Call In wwww Yes No
9 Thayer, Trygve 01-Jan-2003 1 Call In rrrr Yes No
10 Thayer, Trygve 02-Jan-1998 1 Call In Yes No
11 Thayer, Trygve 02-Jan-1999 1 Call In Yes No
12 Thayer, Trygve 02-Jan-2000 2 Call In Yes No
13 Thayer, Trygve 02-Jan-2001 1 Call In Yes No
14 Thayer, Trygve 02-Jan-2002 1 Call In Yes No
15 Thayer, Trygve 01-Feb-2003 1 Call In Yes No
16 Thayer, Trygve 01-Mar-2003 1 Call In Yes No
17 Thayer, Trygve 01-Apr-2003 1 Call In Yes No
18 Thayer, Trygve 15-May-2003 2 Over 2 Yes No
19 Thayer, Trygve 11-Aug-2003 1 Over 2 Yes No
23 Thayer, Trygve 11-Dec-2003 2 Call In No Yes
25 Thayer, Trygve 15-Apr-2003 1 Call In Yes No
27 Thayer, Trygve 12-Apr-2004 2 Call In No Yes
28 Warren, Alan 15-May-2003 2 Over 2 Yes No
29 Warren, Alan 11-Aug-2003 1 Over 2 Yes No
30 Warren, Alan 11-Dec-2003 2 Call In No Yes
31 Warren, Alan 15-Apr-2003 1 Call In Yes No
32 Warren, Alan 12-Apr-2004 2 Call In No Yes
Alan
ASKER
All I did was copy the files from the directory and added 1 record. Here is the code I have and also the records.
Private Sub Command13_Click()
On Error GoTo ReportError
Dim strSQL As String
Dim strWhere As String
Dim strFilesChecked As String ' InClause for sql where condition
' (records to exclude on next loop of active set)
Dim recOccurrence As ADODB.Recordset
Dim recEmployee As ADODB.Recordset
Dim dNextNewestDate As Date
Dim dNextOldestDate As Date
Dim lNextOldestID As Long
Dim lNextNewestID As Long
Dim lRecordChecked As Long
' 1. -The update should check all records and mark the field
' [Occurrence Dropped] if the records are older than 1 year.
strSQL = "UPDATE tblOccurrence SET tblOccurrence.[Occurrence Dropped] = True"
strSQL = strSQL & " WHERE [Date] <=DateAdd('yyyy',-1,Now()) "
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'2. Check all records in the current year and starting with the earliest date
' see if there is a span of more than 4 months
Set recOccurrence = New ADODB.Recordset
Set recEmployee = New ADODB.Recordset
strSQL = "SELECT Distinct tblOccurrence.Employee FROM tblOccurrence"
recEmployee.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
With recEmployee
.MoveFirst
Do While Not .BOF And Not .EOF
Do
' open the active set for this employee
strSQL = "SELECT OccurrenceID, Employee, [Date], [Occurrence Dropped], [Occurrence Reference] FROM tblOccurrence"
strSQL = strSQL & " WHERE Employee='" & .Fields("Employee")
strSQL = strSQL & "' AND [Occurrence Dropped]=False AND [Occurrence Reference]=False"
' Exclude ID's in this active set that we have already checked
If strFilesChecked <> "" Then
strSQL = strSQL & " AND OccurrenceID Not IN(" & Left(strFilesChecked, Len(strFilesChecked) - 1) & ")"
End If
strSQL = strSQL & " Order By Date Asc"
recOccurrence.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
With recOccurrence
' .MoveFirst ' <-- aw 15-apr-2004 moved this down 2 lines
If Not .BOF And Not .EOF Then
.MoveFirst ' <-- aw 15-apr-2004 modified positon of this line
lNextOldestID = .Fields("OccurrenceID")
lRecordChecked = lNextOldestID
dNextOldestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
.MoveNext
If .EOF Then: Exit Do
lNextNewestID = .Fields("OccurrenceID")
dNextNewestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
If dNextOldestDate <= DateAdd("m", -4, dNextNewestDate) Then
' a span of 4 months has been found
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
' Of the two records we are comparing, which record gets marked as
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
' ========================== ========== ======
' Code to mark the oldest occurence, in current year, not marked as dropped,
' for this employee goes here.
'
' note: Get the ID of oldest record not dropped for this Employee
' Then run some sql here to mark as dropped and re-populate the variable
' ========================== ========== ======
strFilesChecked = strFilesChecked & .Fields("OccurrenceID") & ","
Dim lOldestOffenceID As Long
lOldestOffenceID = getOldestActiveOffenceID(. Fields("Em ployee"))
Call doMarkOldestActiveOffenceI D(lOldestO ffenceID)
Call doMarkOccurencReference(lN extNewestI D)
Else
' Add the ID of this record to strFilesChecked(List of records to exclude on next loop)
strFilesChecked = strFilesChecked & lRecordChecked & ","
End If
Else '<-- aw 15-apr-2004 Added the Else to get out of the inner loop if .BOF and .EOF
.Close
Exit Do
End If
.Close
End With
Loop
strFilesChecked = ""
.MoveNext
Loop
End With
ExitProcedure:
On Error Resume Next
Set recOccurrence = Nothing
Set recEmployee = Nothing
Exit Sub
ReportError:
Dim msg As String
msg = "Error in " & Me.Name & "Command11_Click():" _
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
Private Sub doMarkOccurencReference(lN extNewestI D As Long)
' Note: aw 14-apr-2004
' Returns: nothing
' Called by: Form1_Command13_Click()
On Error GoTo ExitProcedure
Dim strSQL As String
Dim strWhere As String
strSQL = "UPDATE tblOccurrence SET [Occurrence Reference] = True"
strSQL = strSQL & " WHERE OccurrenceID =" & lNextNewestID
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
ExitProcedure:
On Error Resume Next
Exit Sub
ReportError:
Dim msg As String
msg = "Error in " & Me.Name & ".doMarkOccurencReference( )" _
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
Private Sub doMarkOldestActiveOffenceI D(lOldestO ffenceID As Long)
' Note: aw 14-apr-2004
' Returns: nothing
' Called by: Form1_Command13_Click()
On Error GoTo ExitProcedure
Dim strSQL As String
Dim strWhere As String
strSQL = "UPDATE tblOccurrence SET [Occurrence Dropped] = True"
strSQL = strSQL & " WHERE OccurrenceID =" & lOldestOffenceID
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
ExitProcedure:
On Error Resume Next
Exit Sub
ReportError:
Dim msg As String
msg = "Error in " & Me.Name & ".doMarkOldestActiveOffenc eID()" _
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
Private Function getOldestActiveOffenceID(e mpName As String) As Long
On Error GoTo ExitProcedure
Dim strSQL As String
Dim strWhere As String
Dim recOldestOffence As ADODB.Recordset
Set recOldestOffence = New ADODB.Recordset
' Note: aw 14-apr-2004
' In the test data OccurenceID's were not consistent with field("Date")
' when an orderby clause was applied
' Also dont need to filter on WHERE [Date] <=DateAdd('yyyy',-1,Now())
' Because update of records matching this descript runs prior to this function
strSQL = "SELECT OccurrenceID, Date FROM tblOccurrence"
strSQL = strSQL & " WHERE Employee='" & empName
strSQL = strSQL & "' AND [Occurrence Dropped]=False ORDER BY [Date]"
recOldestOffence.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
With recOldestOffence
If Not .BOF And Not .EOF Then
.MoveFirst
getOldestActiveOffenceID = .Fields("OccurrenceID").Va lue
.Close
End If
End With
ExitProcedure:
On Error Resume Next
Set recOldestOffence = Nothing
Exit Function
ReportError:
Dim msg As String
msg = "Error in " & Me.Name & ".getOldestActiveOffenceID ()" _
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Function
10 Thayer, Trygve 1/2/1998 1 Call In TRUE FALSE
11 Thayer, Trygve 1/2/1999 1 Call In TRUE FALSE
12 Thayer, Trygve 1/2/2000 2 Call In TRUE FALSE
6 Thayer, Trygve 1/1/2001 2 Call In tttt TRUE FALSE
7 Thayer, Trygve 1/1/2001 2 Call In eeee TRUE FALSE
13 Thayer, Trygve 1/2/2001 1 Call In TRUE FALSE
8 Thayer, Trygve 1/1/2002 1 Call In wwww TRUE FALSE
14 Thayer, Trygve 1/2/2002 1 Call In TRUE FALSE
5 Thayer, Trygve 3/30/2002 2 Call In TRUE FALSE
9 Thayer, Trygve 1/1/2003 1 Call In rrrr TRUE FALSE
15 Thayer, Trygve 2/1/2003 1 Call In TRUE FALSE
16 Thayer, Trygve 3/1/2003 1 Call In TRUE FALSE
17 Thayer, Trygve 4/1/2003 1 Call In TRUE FALSE
1 Thayer, Trygve 4/10/2003 2 Call In yep he TRUE FALSE
25 Thayer, Trygve 4/15/2003 1 Call In TRUE FALSE
18 Thayer, Trygve 5/15/2003 2 Call In TRUE FALSE
19 Thayer, Trygve 8/11/2003 1 Call In FALSE FALSE
23 Thayer, Trygve 12/11/20032 Call In FALSE TRUE
27 Thayer, Trygve 4/12/2004 1 Call In FALSE TRUE
29 Ausmus, Adam 4/14/2004 1 Call In FALSE FALSE
Private Sub Command13_Click()
On Error GoTo ReportError
Dim strSQL As String
Dim strWhere As String
Dim strFilesChecked As String ' InClause for sql where condition
' (records to exclude on next loop of active set)
Dim recOccurrence As ADODB.Recordset
Dim recEmployee As ADODB.Recordset
Dim dNextNewestDate As Date
Dim dNextOldestDate As Date
Dim lNextOldestID As Long
Dim lNextNewestID As Long
Dim lRecordChecked As Long
' 1. -The update should check all records and mark the field
' [Occurrence Dropped] if the records are older than 1 year.
strSQL = "UPDATE tblOccurrence SET tblOccurrence.[Occurrence Dropped] = True"
strSQL = strSQL & " WHERE [Date] <=DateAdd('yyyy',-1,Now())
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'2. Check all records in the current year and starting with the earliest date
' see if there is a span of more than 4 months
Set recOccurrence = New ADODB.Recordset
Set recEmployee = New ADODB.Recordset
strSQL = "SELECT Distinct tblOccurrence.Employee FROM tblOccurrence"
recEmployee.Open strSQL, CurrentProject.Connection,
With recEmployee
.MoveFirst
Do While Not .BOF And Not .EOF
Do
' open the active set for this employee
strSQL = "SELECT OccurrenceID, Employee, [Date], [Occurrence Dropped], [Occurrence Reference] FROM tblOccurrence"
strSQL = strSQL & " WHERE Employee='" & .Fields("Employee")
strSQL = strSQL & "' AND [Occurrence Dropped]=False AND [Occurrence Reference]=False"
' Exclude ID's in this active set that we have already checked
If strFilesChecked <> "" Then
strSQL = strSQL & " AND OccurrenceID Not IN(" & Left(strFilesChecked, Len(strFilesChecked) - 1) & ")"
End If
strSQL = strSQL & " Order By Date Asc"
recOccurrence.Open strSQL, CurrentProject.Connection,
With recOccurrence
' .MoveFirst ' <-- aw 15-apr-2004 moved this down 2 lines
If Not .BOF And Not .EOF Then
.MoveFirst ' <-- aw 15-apr-2004 modified positon of this line
lNextOldestID = .Fields("OccurrenceID")
lRecordChecked = lNextOldestID
dNextOldestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
.MoveNext
If .EOF Then: Exit Do
lNextNewestID = .Fields("OccurrenceID")
dNextNewestDate = Format(.Fields("Date"), "dd-mmm-yyyy")
'If a span of 4 months is found
' and there are no records within the current year marked [Occurrence Reference]
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
If dNextOldestDate <= DateAdd("m", -4, dNextNewestDate) Then
' a span of 4 months has been found
' then mark the oldest record in the current year as dropped
' and mark the record the 4 month span was found.
' Of the two records we are comparing, which record gets marked as
' Fields("Occurrence Reference") = true ????
' dNextOldestDate or dNextNewestDate ????
' ==========================
' Code to mark the oldest occurence, in current year, not marked as dropped,
' for this employee goes here.
'
' note: Get the ID of oldest record not dropped for this Employee
' Then run some sql here to mark as dropped and re-populate the variable
' ==========================
strFilesChecked = strFilesChecked & .Fields("OccurrenceID") & ","
Dim lOldestOffenceID As Long
lOldestOffenceID = getOldestActiveOffenceID(.
Call doMarkOldestActiveOffenceI
Call doMarkOccurencReference(lN
Else
' Add the ID of this record to strFilesChecked(List of records to exclude on next loop)
strFilesChecked = strFilesChecked & lRecordChecked & ","
End If
Else '<-- aw 15-apr-2004 Added the Else to get out of the inner loop if .BOF and .EOF
.Close
Exit Do
End If
.Close
End With
Loop
strFilesChecked = ""
.MoveNext
Loop
End With
ExitProcedure:
On Error Resume Next
Set recOccurrence = Nothing
Set recEmployee = Nothing
Exit Sub
ReportError:
Dim msg As String
msg = "Error in " & Me.Name & "Command11_Click():" _
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
Private Sub doMarkOccurencReference(lN
' Note: aw 14-apr-2004
' Returns: nothing
' Called by: Form1_Command13_Click()
On Error GoTo ExitProcedure
Dim strSQL As String
Dim strWhere As String
strSQL = "UPDATE tblOccurrence SET [Occurrence Reference] = True"
strSQL = strSQL & " WHERE OccurrenceID =" & lNextNewestID
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
ExitProcedure:
On Error Resume Next
Exit Sub
ReportError:
Dim msg As String
msg = "Error in " & Me.Name & ".doMarkOccurencReference(
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
Private Sub doMarkOldestActiveOffenceI
' Note: aw 14-apr-2004
' Returns: nothing
' Called by: Form1_Command13_Click()
On Error GoTo ExitProcedure
Dim strSQL As String
Dim strWhere As String
strSQL = "UPDATE tblOccurrence SET [Occurrence Dropped] = True"
strSQL = strSQL & " WHERE OccurrenceID =" & lOldestOffenceID
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
ExitProcedure:
On Error Resume Next
Exit Sub
ReportError:
Dim msg As String
msg = "Error in " & Me.Name & ".doMarkOldestActiveOffenc
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Sub
Private Function getOldestActiveOffenceID(e
On Error GoTo ExitProcedure
Dim strSQL As String
Dim strWhere As String
Dim recOldestOffence As ADODB.Recordset
Set recOldestOffence = New ADODB.Recordset
' Note: aw 14-apr-2004
' In the test data OccurenceID's were not consistent with field("Date")
' when an orderby clause was applied
' Also dont need to filter on WHERE [Date] <=DateAdd('yyyy',-1,Now())
' Because update of records matching this descript runs prior to this function
strSQL = "SELECT OccurrenceID, Date FROM tblOccurrence"
strSQL = strSQL & " WHERE Employee='" & empName
strSQL = strSQL & "' AND [Occurrence Dropped]=False ORDER BY [Date]"
recOldestOffence.Open strSQL, CurrentProject.Connection,
With recOldestOffence
If Not .BOF And Not .EOF Then
.MoveFirst
getOldestActiveOffenceID = .Fields("OccurrenceID").Va
.Close
End If
End With
ExitProcedure:
On Error Resume Next
Set recOldestOffence = Nothing
Exit Function
ReportError:
Dim msg As String
msg = "Error in " & Me.Name & ".getOldestActiveOffenceID
& vbCr & "Error number " & CStr(Err.Number) _
& " was generated by " & Err.Source _
& vbCr & Err.Description
MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
Resume ExitProcedure
End Function
10 Thayer, Trygve 1/2/1998 1 Call In TRUE FALSE
11 Thayer, Trygve 1/2/1999 1 Call In TRUE FALSE
12 Thayer, Trygve 1/2/2000 2 Call In TRUE FALSE
6 Thayer, Trygve 1/1/2001 2 Call In tttt TRUE FALSE
7 Thayer, Trygve 1/1/2001 2 Call In eeee TRUE FALSE
13 Thayer, Trygve 1/2/2001 1 Call In TRUE FALSE
8 Thayer, Trygve 1/1/2002 1 Call In wwww TRUE FALSE
14 Thayer, Trygve 1/2/2002 1 Call In TRUE FALSE
5 Thayer, Trygve 3/30/2002 2 Call In TRUE FALSE
9 Thayer, Trygve 1/1/2003 1 Call In rrrr TRUE FALSE
15 Thayer, Trygve 2/1/2003 1 Call In TRUE FALSE
16 Thayer, Trygve 3/1/2003 1 Call In TRUE FALSE
17 Thayer, Trygve 4/1/2003 1 Call In TRUE FALSE
1 Thayer, Trygve 4/10/2003 2 Call In yep he TRUE FALSE
25 Thayer, Trygve 4/15/2003 1 Call In TRUE FALSE
18 Thayer, Trygve 5/15/2003 2 Call In TRUE FALSE
19 Thayer, Trygve 8/11/2003 1 Call In FALSE FALSE
23 Thayer, Trygve 12/11/20032 Call In FALSE TRUE
27 Thayer, Trygve 4/12/2004 1 Call In FALSE TRUE
29 Ausmus, Adam 4/14/2004 1 Call In FALSE FALSE
Ok got it mate.
' from here:
Set recOccurrence = New ADODB.Recordset
Set recEmployee = New ADODB.Recordset
strSQL = "SELECT Distinct tblOccurrence.Employee FROM tblOccurrence"
recEmployee.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
With recEmployee
.MoveFirst
Do While Not .BOF And Not .EOF
'===================== ' add this if block here
If recOccurrence.State <> 0 Then
recOccurrence.Close
End If
'=====================
Do
Alan
' from here:
Set recOccurrence = New ADODB.Recordset
Set recEmployee = New ADODB.Recordset
strSQL = "SELECT Distinct tblOccurrence.Employee FROM tblOccurrence"
recEmployee.Open strSQL, CurrentProject.Connection,
With recEmployee
.MoveFirst
Do While Not .BOF And Not .EOF
'===================== ' add this if block here
If recOccurrence.State <> 0 Then
recOccurrence.Close
End If
'=====================
Do
Alan
ASKER
Got It. It did not mark anything but that is what I expected. What was happening?
p.s. sent you a zip file before I saw your post.
p.s. sent you a zip file before I saw your post.
The recOccurence recordset was still open and I was trying to open it again after moving to next employee.
One of the gotcha's of using Exit Do
Alan
ASKER
Thanks,
I will continue on with development. I did get a boomerang today but think I have a solution. HR manager said it was possible to record an occurrence that was excused in which the value would be 0 or not count. If when that happens I think the one entering the record should mark [Occurrence Dropped] manually and then all should work. I think..... Have not tested that yet. Still recovering from the all nighter. When the supervisor called me and said he saw the server smoking he was not joking.
I will continue on with development. I did get a boomerang today but think I have a solution. HR manager said it was possible to record an occurrence that was excused in which the value would be 0 or not count. If when that happens I think the one entering the record should mark [Occurrence Dropped] manually and then all should work. I think..... Have not tested that yet. Still recovering from the all nighter. When the supervisor called me and said he saw the server smoking he was not joking.
What was it smoking? LOL
ASKER
The Cleaning people decided the computer room needed mopping. Not to good when you sling water into computers.
ASKER
alanwarren.......the HR guy did it again !!!!
https://www.experts-exchange.com/questions/20956032/Code-to-update-an-attendance-table.html
https://www.experts-exchange.com/questions/20956032/Code-to-update-an-attendance-table.html
I've seen the question and it will indeed take some time.
Puzzled why you mark all the rows matching a criteria as normally just using a query with a WHERE is just doing what you need.
But OK to give you a start you can create a set of two queries having the rows sequenced by a +1 incremented sequence number and one with the same sequence but starting with 2 instead of 1 (just use the same query but add +1 to the sequence field).
These two queries can be JOINed on Employee and that sequence field, thus giving you in one row the start and the enddate, allowing to calculate the duration you can test for the IF in your second point.
I'll have to look into the other things later (after my dinner)
Nic;o)