'-----------------------------------------------------------------------------
' Procedure : CustomSerialNo
' Author : Jack
' Date : 21/01/2013
' Purpose : A function to generate a custom serial number made up of
' Year and Month in YYYYMM format
' -
' a sequential number that resets on the change in Month
'
' Parameter: The date of production/manufacturing or whatever.
'
'***********************************************************
'
[B][COLOR="Green"]' This function uses a table named --tblMyAdminData--, with fields
' CurrentYearMonth Text
' LatestSerialNo Number
'
'There is only one record in the table.
'Preset the table with the starting YearMonth and SerialNo.
'The LatestSerialNo is updated/incremented when a new SerialNo is generated.
'
'However, if the month has changed since last run,
'the Year and Month are updated and
'the LatestSerialNo is reset to 0[/COLOR][/B]
'
'---------------------------------------------------------------------------------------
'
Function CustomSerialNo(MyDate As Date) As String
If Len(MyDate) = 0 Then Exit Function
If Not IsDate(MyDate) Then
MsgBox "Invalid Date supplied"
Exit Function
End If
If Year(MyDate) = 1900 Then 'if only a day is supplied, Access may assume 1900???
MsgBox "Bad Date supplied"
Exit Function
End If
Dim mySer As String
Dim CurYearMonth As String 'CurrentYearMonth from tblMyAdminData
Dim HiSer As Long 'LatestSerialNo from tblMyAdminData
Dim SQL1 As String 'Update for New Month
Dim SQL2 As String 'update of LatestSerialNo
On Error GoTo CustomSerialNo_Error
'get the LatestSerialNo and yearMonth fromtblMyAdminData
HiSer = DLookup("LatestSerialNo", "tblMyAdminData")
CurYearMonth = DLookup("CurrentYearMonth", "tblMyAdminData") 'format is YYYYMM
'Debug.Print CurYearMonth 'for debugging
'Debug.Print HiSer 'for debugging
'CHECK if the MONTH has Changed***********
If Year(MyDate) & Format(Month(MyDate), "00") <> CurYearMonth Then
'when the month changes
' update the tblMyAdminData with
' the proper Year and Month
' reset the LatestSerialNo to 0
SQL1 = " Update tblMyAdminData " _
& " SET CurrentYearMonth = '" & Year(MyDate) & Format(Month(MyDate), "00") & "', " _
& " LatestSerialNo = 0"
' Debug.Print SQL 'for debugging
CurrentDb.Execute SQL1, dbFailOnError
End If
'Now get the values reflective of the Changed Month if there has been an update
HiSer = DLookup("LatestSerialNo", "tblMyAdminData")
CurYearMonth = DLookup("CurrentYearMonth", "tblMyAdminData") 'format is YYYYMM
HiSer = HiSer + 1 'increment the number
SQL2 = "Update tblMyAdminData SET LatestSerialNo = " & HiSer
'Debug.Print SQL2 'for debugging
CurrentDb.Execute SQL2, dbFailOnError 'update the tblMyAdminData LatestSerialNo
mySer = CurYearMonth & "-" & HiSer
'Debug.Print mySer 'for debugging
CustomSerialNo = mySer
'MySer is the value you would assign to the new product
On Error GoTo 0
Exit Function
CustomSerialNo_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CustomSerialNo of Module Module1"
End Function