Check Microsoft Access Form Values before Save - ms-access

I have an Access Form - lets call it "Add Labor" (Access 2007) that saves data into a table.
The table has two columns in particular called "Start Date" and "End Date" (This table stores tasks)
There is also another table called FiscalYears which includes Start and End Dates for Fiscal Years, which is structured as follows
FyID
FYear
StartDate
EndDate
Example Data:
FYId FYear StartDate EndDate
-----------------------------
1 2010 10/1/2009 9/30/2010
2 2011 10/1/2010 9/30/2011
So in My Add Labor Form if someone enters labor that span across two fiscal years I need to enter two labor entries. Here is an example
If a user selects Labor Start Date = 6/30/2009
And End Date 10/2/2010 , it spans two fiscal years
So in my Labor Table I should enter two things
LaborID StartDate EndDate
-----------------------------
1 6/30/2009 9/30/2010
2 10/1/2010 10/2/2010
Basically I need to do a check before I save the record and add two records if they span Fiscal years, right now I'm just blindly doing Save Record on the form (inbuilt), but I guess I need to add some VBA. I've hardly ever used Access so this may be simple(hopefully). I am thinking instead of the event which just calls Save Record, I need it to add custom VBA.

Say you have an unbound form for adding the dates, you can say:
Dim rsFY As DAO.Recordset
Dim rsAL As DAO.Recordset
Dim db As Database
Dim sSQL As String
Set db = CurrentDb
''Select all years from the fiscal years table
sSQL = "SELECT FYear, StartDate, EndDate " _
& "FROM FiscalYears WHERE StartDate>=#" & Format(Me.StartDate, "yyyy/mm/dd") _
& "# Or EndDate <=#" & Format(Me.Enddate, "yyyy/mm/dd") _
& "# ORDER BY FYear"
Set rsFY = db.OpenRecordset(sSQL)
Set rsAL = db.OpenRecordset("AddLabor") ''table
''Populate recordset
rsFY.MoveLast
rsFY.MoveFirst
Do While Not rsFY.EOF
''Add records for each year selected
rsAL.AddNew
If rsFY.AbsolutePosition = 0 Then
rsAL!StartDate = Format(Me.StartDate, "yyyy/mm/dd")
Else
rsAL!StartDate = rsFY!StartDate
End If
If rsFY.AbsolutePosition + 1 = rsFY.RecordCount Then
rsAL!Enddate = Format(Me.Enddate, "yyyy/mm/dd")
Else
rsAL!Enddate = rsFY!Enddate
End If
rsAL.Update
rsFY.MoveNext
Loop
If the code was running in a main form with a subform showing the Addlabor table, you could update the subform to show the new records like so:
Me.Addlabor_subform.Requery

Why do you need a FiscalYears table? If your organization's fiscal years always start on Oct. 1 and end on Sept. 30, you can use a function to determine the fiscal year for a given date.
Public Function Fy(ByVal pDate As Date) As Integer
Dim intYear As Integer
Dim intReturn As Integer
intYear = Year(pDate)
If pDate > DateSerial(intYear, 9, 30) Then
intReturn = intYear + 1
Else
intReturn = intYear
End If
Fy = intReturn
End Function
And simple functions to return the Start and End dates for a given year.
Public Function FyStart(ByVal pYear As Integer) As Date
FyStart = DateSerial(pYear - 1, 10, 1)
End Function
Public Function FyEnd(ByVal pYear As Integer) As Date
FyEnd = DateSerial(pYear, 9, 30)
End Function
You can then determine how many fiscal years are included in a given date range by:
Fy(EndDate) - Fy(StartDate)
But I may be totally off base because you said "Start Date = 6/30/2009 And End Date 10/2/2010" spans two years. However, this expression returns 2 (3 years):
Fy(#10/2/2010#) - Fy(#6/30/2009#)

Related

How to remove fractions of seconds from a Date variable?

Background:
I read the pwdLastSet attribute from Active Directory, and want to store it in a DATETIME2(0) column in a SQL Server table. I don't want to store fractions of seconds.
It's an 8-byte Integer, expressed in 100-nanosecond steps since 12:00 AM, January 1, 1601. I use this function to convert it to a Date variable.
This continued to fail with ODBC-call failed, and it took me quite some time to figure out that the extra precision returned by that function caused the error.
Question:
What is the best way to remove fractions of seconds from a Date variable?
How to reproduce:
I use SQL Server 2008 R2 and Access 2010.
In SQL Server:
CREATE TABLE TestDT (
ID INT NOT NULL,
colDT2 DATETIME2(0) NULL,
CONSTRAINT PK_TestDT PRIMARY KEY (ID)
)
GO
INSERT TestDT (ID) VALUES (1)
GO
Link that table into Access, using Native Client ODBC driver or the current Microsoft ODBC Driver 17 for SQL Server. The default "SQL Server" driver doesn't really know how to work with DATETIME2.
In Access VBA:
Public Sub TestDT()
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim dte As Date
Dim i As Long
Set DB = CurrentDb
' Random date+time
dte = CDate("2018-12-24 15:16:17")
' 1st iteration: write original date+time -> works
' 2nd iteration: try to write date+time with fractional seconds -> error for DATETIME2(0) column
For i = 1 To 2
If i = 2 Then
' Introduce milliseconds nastiness
dte = dte + 0.00001
End If
Debug.Print "Iteration " & i, Format(dte, "yyyy-mm-dd hh:nn:ss")
Set RS = DB.OpenRecordset("SELECT * FROM TestDT WHERE ID = 1", dbOpenDynaset)
With RS
.Edit
!colDT2 = dte
On Error Resume Next
.Update
If Err.Number <> 0 Then
Debug.Print "Error " & Err.Number, Err.Description
' The DAO Errors collection shows the actual error
Debug.Print Errors(0).Description
Else
Debug.Print "Update OK"
End If
On Error GoTo 0
.Close
End With
Next i
End Sub
Output:
Iteration 1 2018-12-24 15:16:17
Update OK
Iteration 2 2018-12-24 15:16:18
Error 3146 ODBC-Aufruf fehlgeschlagen.
[Microsoft][ODBC Driver 17 for SQL Server]Datetime field overflow.
Fractional second precision exceeds the scale specified in the parameter binding.
You could round off to the second this way:
PwdLastSetSecond = CDate(Int(PwdLastSet * 86400) / 86400)
I came up with
dte = CDate(Int(dte) + TimeSerial(Hour(dte), Minute(dte), Second(dte)))
but that's rather clumsy. :(
The correct function in Access to strip out the time part is:
DateValue(“date/time” expression)
So you thus get:
dte = DateValue (CDate("2018-12-24 15:16:17") )
or DateValue (whatever date time expression)
The correct function in Access to strip out the time part is:
TimeValue(“date/time” expression)
So you thus get:
dte = TimeValue (CDate("2018-12-24 15:16:17") )
or TimeValue (whatever date/ time expression)
If you need to save or strip out the time part into a separate value, then go:
dtMyTime = TimeValue ( (CDate("2018-12-24 15:16:17") )
However YOUR ISSUE is NOT stripping out Date, or time.
There is NO SUCH thing as “.ms” for the format.
That going to give you month + seconds.
If you look close:
2018-12-24 15:16:17.1217
In above, te 1217 is 12th month, and 17 seconds..
There is NO SUCH thing as “ms” for the format. So this is why you are seeing a overflow.
So you CAN NOT USE “.ms”.
You can only get the seconds in Access.
Just use a standard format command. If you want to strip out the "extra" time:
Set rst = CurrentDb.OpenRecordset("dbo_TimeTest2", dbOpenDynaset, dbSeeChanges)
rst.Edit
rst!StartTimeD = Format(rst!StartTimeD, "MM-DD-YYYY hh:nn:ss")
rst.Update
DANGER DANGER will Robinson. Access does not use or support “ms” in the format.
Simply using above “format” on the existing date/time you get will pull out and toss out the extra values after the seconds.

calculation of expiration dates with sql

my first time doing a date calculation on my system
as you can see here on my first query how would i say that my expdate table is equal to this current date? then if so msgbox me "your item has expired"
on my second query i wanted to set a msgbox where msgbox me three months before my expdate ?
heres what i tried to do
cn.Open()
Dim query As String
query = "Select * from tblmeds where TIMESTAMPDIFF(MONTH,`expdate`,CURRENT_TIMESTAMP())< 1"
command = New MySqlCommand(query, cn)
readers = command.ExecuteReader
Dim count As Integer
count = 0
While readers.Read
count = count + 1
End While
cn.Close()
If count = 1 Then
msgbox "you have a expired items"
else
"no items are at risk"
PS:i am currently using PHPMYADMIN as my database
Assuming SQL SErver...
Subtract 3 months from the expiration date and compare that to the utc date (if multiple timezones are involved) otherwise you could just use getDate()
SELECT EXPDATE
FROM tblMeds
WHERE Dateadd(Month, -3,expDate) < = getutcdate()
If you change you query to
query = "Select count(*) as cnt from tblmeds where TIMESTAMPDIFF(MONTH,`expdate`,CURRENT_TIMESTAMP())< 1"
Then you won't need a look to count the rows, the server can do that which is faster.

capture dates by quarters in access

To make my life much easier working with my data I set 3 columns of same date content. The first displays in the format mm/dd/yyyy, second in the format of yyyy-mm and the third in the format yyyy-q.
I did it purposely due to my reports. Sometimes I need to create monthly, quarterly, yearly etc. Usually I work with a form where I invite the user select start and end date and by a click of a button run a report. This report extracts a query where I specify on the date section to pull all information between start and end date. This time I want to do the same procedure but instead of start and end date - I want the user to select which quarter he wants so that the query will pull all information regarding this quarter. What do I specify in the criteria to archive this?
Filter on
DatePart("q", [YourDateField])
or
Format([YourDateField], "yyyyq")
To obtain the first and last date of a quarter, given the year and the quarter, you can use these expressions:
DateQuarterFirst = DateSerial(Y, 1 + 3 * (Q - 1), 1)
DateQuarterLast = DateSerial(Y, 1 + 3 * Q, 0)
If you have a date of the quarter, you can these functions to obtain the first and last date of the quarter of that date:
Public Function DateThisQuarterFirst( _
Optional ByVal datDateThisQuarter As Date) As Date
Const cintQuarterMonthCount As Integer = 3
Dim intThisMonth As Integer
If datDateThisQuarter = 0 Then
datDateThisQuarter = Date
End If
intThisMonth = (DatePart("q", datDateThisQuarter) - 1) * cintQuarterMonthCount
DateThisQuarterFirst = DateSerial(Year(datDateThisQuarter), intThisMonth + 1, 1)
End Function
Public Function DateThisQuarterLast( _
Optional ByVal datDateThisQuarter As Date) As Date
Const cintQuarterMonthCount As Integer = 3
Dim intThisMonth As Integer
If datDateThisQuarter = 0 Then
datDateThisQuarter = Date
End If
intThisMonth = DatePart("q", datDateThisQuarter) * cintQuarterMonthCount
DateThisQuarterLast = DateSerial(Year(datDateThisQuarter), intThisMonth + 1, 0)
End Function

Sum values in one field based on date range in another

I have two tables, both with dates (which is what they are/will be joined on)
Table 1 has daily rainfall values
Table 2 has weekly water volume values.
I'm trying to get Access to calculate the weekly rainfall (from the daily values) based on the dates that are given for the water volumes ie: total rainfall between two dates calculated dynamically. I have some experience with using Access SQL but I am stumped on this one. To add to the complication, every once in a while the volume values aren't always 7 days apart.
One method is to find the week numbers from each table, then join between these:
Select
Sum(Table1.Volume) As Volume1,
ISO_Weeknumber(Table1.[datefield]) As WeekNumber1,
Sum(Table2.Volume) As Volume2,
ISO_Weeknumber(Table2.[datefield]) As WeekNumber2
From
Table1
Inner Join
Table2
On ISO_Weeknumber(Table1.[datefield])=ISO_Weeknumber(Table2.[datefield])
Group By
ISO_Weeknumber(Table1.[datefield]),
ISO_Weeknumber(Table2.[datefield])
using this function:
Public Function ISO_WeekYearNumber( _
ByVal datDate As Date, _
Optional ByRef intYear As Integer, _
Optional ByRef bytWeek As Byte) _
As String
' Calculates and returns year and week number for date datDate according to the ISO 8601:1988 standard.
' Optionally returns numeric year and week.
' 1998-2007, Gustav Brock, Cactus Data ApS, CPH.
' May be freely used and distributed.
Const cbytFirstWeekOfAnyYear As Byte = 1
Const cbytLastWeekOfLeapYear As Byte = 53
Const cbytMonthJanuary As Byte = 1
Const cbytMonthDecember As Byte = 12
Const cstrSeparatorYearWeek As String = "W"
Dim bytMonth As Byte
Dim bytISOThursday As Byte
Dim datLastDayOfYear As Date
intYear = Year(datDate)
bytMonth = Month(datDate)
bytWeek = DatePart("ww", datDate, vbMonday, vbFirstFourDays)
If bytWeek = cbytLastWeekOfLeapYear Then
bytISOThursday = Weekday(vbThursday, vbMonday)
datLastDayOfYear = DateSerial(intYear, cbytMonthDecember, 31)
If Weekday(datLastDayOfYear, vbMonday) >= bytISOThursday Then
' OK, week count of 53 is caused by leap year.
Else
' Correct for Access97/2000+ bug.
bytWeek = cbytFirstWeekOfAnyYear
End If
End If
' Adjust year where week number belongs to next or previous year.
If bytMonth = cbytMonthJanuary Then
If bytWeek >= cbytLastWeekOfLeapYear - 1 Then
' This is an early date of January belonging to the last week of the previous year.
intYear = intYear - 1
End If
ElseIf bytMonth = cbytMonthDecember Then
If bytWeek = cbytFirstWeekOfAnyYear Then
' This is a late date of December belonging to the first week of the next year.
intYear = intYear + 1
End If
End If
ISO_WeekYearNumber = CStr(intYear) & cstrSeparatorYearWeek & Format(bytWeek, "00")
End Function
For this to work, you must have all weeks in Table1 that exist in Table2 and vice versa.

#type Error on VBA function when input left blank

I am using the following code in Access 2010. I use it in an unbound text box to return weekdays between two schedule dates (start/Finish) on various scheduled tasks on a form. Code is working properly when dates are entered, however on this particular form not every task will have start / end dates. I would like the code to just return "" or 0 if inputs are blank.
I should note I did not write this code myself, I am very very new to VBA and found this code online and manipulated it slightly to work for my application. How can I modify this to fit my needs?
Public Function Weekdays( ByRef startDate As Date, _
ByRef endDate As Date _
) As Integer
' Returns the number of weekdays in the period from startDate
' to endDate inclusive. Returns -1 if an error occurs.
' If your weekend days do not include Saturday and Sunday and
' do not total two per week in number, this function will
' require modification.
On Error GoTo Weekdays_Error
' The number of weekend days per week.
Const ncNumberOfWeekendDays As Integer = 2
' The number of days inclusive.
Dim varDays As Variant
' The number of weekend days.
Dim varWeekendDays As Variant
' Temporary storage for datetime.
Dim dtmX As Date
' Calculate the number of days inclusive (+ 1 is to add back startDate).
varDays = DateDiff(Interval:="d", _
date1:=startDate, _
date2:=endDate) + 1
' Calculate the number of weekend days.
varWeekendDays = (DateDiff(Interval:="ww", _
date1:=startDate, _
date2:=endDate) _
* ncNumberOfWeekendDays) _
+ IIf(DatePart(Interval:="w", _
Date:=startDate) = vbSunday, 1, 0) _
+ IIf(DatePart(Interval:="w", _
Date:=endDate) = vbSaturday, 1, 0)
' Calculate the number of weekdays.
Weekdays = (varDays - varWeekendDays)
Weekdays_Exit:
Exit Function
Weekdays_Error:
Weekdays = -1
Resume Weekdays_Exit
End Function
Your code will have to accept a Null value, since Date is a Data type that will not tolerate Null, you have two methods, change the declaration of the function from.
Public Function Weekdays( ByRef startDate As Date, _
ByRef endDate As Date _
) As Integer
To,
Public Function Weekdays(startDate, endDate) As Integer
This way the code can have Null values, so a few more additions could be made as,
Public Function Weekdays(startDate, endDate) As Integer
' Returns the number of weekdays in the period from startDate
' to endDate inclusive. Returns -1 if an error occurs.
' If your weekend days do not include Saturday and Sunday and
' do not total two per week in number, this function will
' require modification.
On Error GoTo Weekdays_Error
If IsNull(startDate) Or IsNull(endDate) Then
Weekdays = 0
Exit Function
End If
Const ncNumberOfWeekendDays As Integer = 2
'so on....
Or the other way is to make sure you pass dates by employing Nz() or even prevent the function to be called if you have Null values.