M
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
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