Help with code

[matt donker via AccessMonster.com]

Hey guys, i am trying to make the database output the data in a table then
delete the data on the last day of the month. However it is the 4ht of
april right now so i am testing it trying to get the result from the
function to be true today. Anyways i can't get it to work and i have no
idea where the problem lies can someone please help me???? and yes i am
obivously a rookie at this. the recordthere statement is in quotes so i
could make sure it was not the reason the code wasn't running. Note: the
function being called is at the bottom of the code.

Option Compare Database

Private Sub CardNumber_LostFocus()


'Make an archived record and then delete old records if it is the first of
the month
'Make variable to insure code is only run once on the first day of the month
Static RecordThere As Integer

If FindLastDay() Then
'RecordThere = RecordThere + 1
' If RecordThere = 1 Then

'Declare month and year variables
Dim Month$, Year$
Dim MonthNum As Long
Month$ = DatePart("m", Date) - 1
Year$ = DatePart("yyyy", Date)
MonthNum = DatePart("m", Date) - 1

'Make the month = december if it is 0
If Month$ = 0 Then
Month$ = 12
End If

If MonthNum = 0 Then
MonthNum = 12
End If


'Replace the month number with text
If Month$ = 1 Then
Month$ = "January"
ElseIf Month$ = 2 Then
Month$ = "February"
ElseIf Month$ = 3 Then
Month$ = "March"
ElseIf Month$ = 4 Then
Month$ = "April"
ElseIf Month$ = 5 Then
Month$ = "May"
ElseIf Month$ = 6 Then
Month$ = "June"
ElseIf Month$ = 7 Then
Month$ = "July"
ElseIf Month$ = 8 Then
Month$ = "August"
ElseIf Month$ = 9 Then
Month$ = "September"
ElseIf Month$ = 10 Then
Month$ = "October"
ElseIf Month$ = 11 Then
Month$ = "November"
ElseIf Month$ = 12 Then
Month$ = "December"
End If

'Output the archived record to a file called the month name
and year
DoCmd.OutputTo acOutputTable, "tblInventoryTaken",
acFormatXLS, "\\tor-file-01\BusinessImprovement\AssemblySummer\mto08428\
Computer Inventory Database- Active\InventoryArchives\" & Month$ & Year$
DoCmd.OutputTo acOutputTable, "tblToolingTracker",
acFormatXLS, "\\tor-file-01\BusinessImprovement\AssemblySummer\mto08428\
Computer Inventory Database- Active\ToolingArchives\" & Month$ & Year$
' End If
End If

If Format(Date, "dddd") = "Thursday" Then
If DatePart(d, Date) > 8 Then
'Run SQL that deletes all records on inventory
DoCmd.SetWarnings False
Dim strSQL As String

strSQL = "DELETE * " _
& " FROM [tblInventoryTaken] " _
& " WHERE DatePart('m', [Date Taken]) =" & MonthNum

DoCmd.RunSQL strSQL

'Deletes records on tooling
Dim strSQLT As String

strSQLT = "DELETE * " _
& " FROM [tblToolingTracker] " _
& " WHERE DatePart('m',[Date]) =" & MonthNum

DoCmd.RunSQL strSQLT
End If
End If


End Sub

Private Sub StartupButton1_Click()
On Error GoTo ErrorFix
'Change focus and make the button invisible again'
DoCmd.GoToControl "CardNumber"
StartupButton1.Visible = False

'Run the query and open the form
DoCmd.OpenQuery "qryCardNumber"
DoCmd.OpenForm "frmWelcome"
DoCmd.Close acQuery, "qryCardNumber"



'Use query information to open appropriate form

If Forms![frmWelcome]![Privilege].Value = "Administrator" Then
DoCmd.OpenForm "frmPassword"

ElseIf Forms![frmWelcome]![Privilege].Value = "User" Then
DoCmd.OpenForm "frmUser"

ElseIf Forms![frmWelcome]![Privilege].Value = "Supervisor" Then
DoCmd.OpenForm "frmSupervisor"
End If





Exit Sub

'Error Statement
ErrorFix:
MsgBox "Invalid Card Number", vbCritical
Forms![frmStartUp]![CardNumber] = Null
DoCmd.Close acForm, "frmWelcome"





End Sub
Function FindLastDay() As Boolean
On Err GoTo err_FindLastDay

Dim thedate As Date
Dim themonth As Integer
Dim lastday As Date
Dim thenextmonth As Date
Dim theyear As Integer

'get todays date
thedate = Date

'find out what the month is
themonth = Month(thedate)

'find out what the first day of the next month is
thenextmonth = DateAdd("m", 1, thedate)
themonth = Month(thenextmonth)
theyear = Year(thenextmonth)
thefirstday = CDate("01/" & themonth & "/" & theyear)

'find out what the last day of the month is
lastday = DateAdd("d", -27, thefirstday)

If thedate = lastday Then
FindLastDay = True
Else
FindLastDay = False
End If

exit_FindLastDay:
Exit Function
err_FindLastDay:
MsgBox Err.Description
Resume exit_FindLastDay

End Function

 

[matt donker via AccessMonster.com]

thefirstday = CDate(themonth & "/" & "01" & "/" & theyear)
found the answer just had to change the line to this if anyone else cares.

 

[Mike Painter]

Hey guys, i am trying to make the database output the data in a table
then delete the data on the last day of the month. However it is the
4ht of april right now so i am testing it trying to get the result
from the function to be true today. Anyways i can't get it to work
and i have no idea where the problem lies can someone please help
me???? and yes i am obivously a rookie at this. the recordthere
statement is in quotes so i could make sure it was not the reason the
code wasn't running. Note: the function being called is at the bottom
of the code.

There is rarely a reason for moving records to an archieved status in
another table.
It makes compareing previous information difficult.

A query to select the current values is all that is needed.

Performance is not an issue and hasn't been since about the time 300Mhz was
reached.