J
Joker via AccessMonster.com
Hello,
I have a user defined function (Below) that when its run it returning an
Unknown Jet Error. I know that the information going into it is valid.
Would someone pleae able to take a look at the code and see if their is an
validation rule that is being violated that I'm just not seeing? Thanks.
Option Compare Database
Public Function fncDueDate(pFrequency As String, pDays As Variant, Procdt As
Date) As Variant
'This is the main module for the remit date function
'This module will call on modules to calculate for "BD" "CD" "Daily" "FCD"
and "Other"/"Exceptions"
Dim Dailyjkr As Date
Dailyjkr = Procdt - 1
If IsNull(pFrequency) Or IsNull(pDays) Then
fncDueDate = Null
Else
Select Case pFrequency
' Case Null
' IsNull
Case "BD"
GoTo BDFunk 'Call Function BDFunk
Case "CD"
GoTo CDFunk 'Call Function CDFunk
Case "Daily" 'Daily only returns the current date. This is because
the remittance would drop last night with 1BD making it today.
GoTo Daily
Case "FCD"
GoTo FCDFunk 'Call Function for FCD
'*************************************************************************************************
'*************************************EXCEPTIONS**************************************************
'**************************ADD HERE ANY ODD REMIT/PAYOFF
DATES************************************
Case "3BD prior to 18th"
GoTo THREEBD18TH 'Call function THREEBD18TH to calculate 3
business days prior to the 18th
Case Else
fncDueDate = Null 'If the remittance frequency doesn't match any
of the above it will result null to make it easier to find new exceptions
GoTo Batcave
End Select
End If
'---------------------------------------DAILY---------------------------------
---------------------
Daily:
fncDueDate = GetBusinessDay(Dailyjkr + 1, 1) 'this just sets it to the next
business day
'fncDueDate = Dailyjkr
GoTo Batcave
'---------------------------------------Calendar days-------------------------
---------------------
CDFunk:
If Day(Procdt) > pDays Then 'Is the day that it should be remitted
already past for this month? If so go to next month
fncDueDate = DateAdd("m", 1, Procdt) 'add one month
fncDueDate = DateSerial(Year([fncDueDate]), Month([fncDueDate]), Day(
[pDays]) + 1) 'set the date static
DateValue (fncDueDate) 'this is to make sure that the value remains a
date
fncDueDate = GetWorkDay(fncDueDate) 'runs the function that if the
day falls on a weekend/holiday it will go back to the previous weekday
GoTo Batcave
Else
fncDueDate = Procdt 'this is the starting point giving it a date
fncDueDate = DateSerial(Year(fncDueDate), Month([fncDueDate]), Day
(pDays) + 1) 'set the date static
fncDueDate = FormatDateTime(fncDueDate, vbShortDate) 'formats date as
short date
DateValue (fncDueDate) 'this makes sure that it is in date format
fncDueDate = GetWorkDay(fncDueDate) 'runs the function that if the
day falls on a weekend/holiday it will go back to the previous weekday
GoTo Batcave
GoTo Batcave
End If
'---------------------------------------Business Days-------------------------
---------------------
BDFunk:
fncDueDate = GetBusinessDay(Dailyjkr + 1, pDays) 'This just adds whatever
number is in tbl_RemitDays!Days to the current day using only business days
(HOLIDAYS NOT INCLUDED)
GoTo Batcave
'---------------------------------------Floating Calendar Days----------------
---------------------
FCDFunk:
fncDueDate = Procdt
fncDueDate = DateSerial(Year(fncDueDate), Month([fncDueDate]), Day
(fncDueDate) + pDays) 'this adds however many days to the process date
fncDueDate = FormatDateTime(fncDueDate, vbShortDate)
DateValue (fncDueDate) 'this makes sure that it is in date format
fncDueDate = GetWorkDay(fncDueDate) 'runs the function that if the
day falls on a weekend/holiday it will go back to the previous weekday
GoTo Batcave
'*************************************************************************************************
'*************************************EXCEPTIONS**************************************************
'**************************ADD HERE ANY ODD REMIT/PAYOFF
DATES************************************
THREEBD18TH:
If Day(18) > pDays Then 'Is the day that it should be remitted already
past for this month? If so go to next month
fncDueDate = DateAdd("m", 1, Procdt) 'add one month
fncDueDate = Procdt
fncDueDate = UpBusDays3(DateSerial(Year(fncDueDate), Month([fncDueDate]), Day
(18) + 1), 3, False)
Else
fncDueDate = Procdt
fncDueDate = UpBusDays3(DateSerial(Year(fncDueDate), Month([fncDueDate]), Day
(18) + 1), 3, False)
End If
GoTo Batcave
'*************************************************************************************************
Batcave: 'this just exits the code
FormatDateTime (fncDueDate)
fncDueDate = fncDueDate
'End Select
End Function
Function GetBusinessDay(datStart As Date, intDayAdd As Variant)
On Error GoTo Error_Handler
'Adds/Subtracts the proper Business day skipping holidays and weekends
'Requires a table (tblHolidays) with a date field (HolidayDate)
'Arvin Meyer 05/26/98 revised 3/12/2002
'© Arvin Meyer 1998 - 2002 You may use this code in your application provided
author
' is given credit. This code may not be distributed as part of a collection
' without prior written permission. This header must remain intact.
Dim rst As DAO.Recordset
Dim DB As DAO.Database
'Dim strSQL As String
Set DB = CurrentDb
Set rst = DB.OpenRecordset("SELECT [HolidayDate] FROM tblHolidays",
dbOpenSnapshot)
If intDayAdd > 0 Then
Do While intDayAdd > 0
datStart = datStart + 1
rst.FindFirst "[HolidayDate] = #" & datStart & "#"
If Weekday(datStart) <> vbSunday And Weekday(datStart) <> vbSaturday
Then
If rst.NoMatch Then intDayAdd = intDayAdd - 1
End If
Loop
ElseIf intDayAdd < 0 Then
Do While intDayAdd < 0
datStart = datStart - 1
rst.FindFirst "[HolidayDate] = #" & datStart & "#"
If Weekday(datStart) <> vbSunday And Weekday(datStart) <> vbSaturday
Then
If rst.NoMatch Then intDayAdd = intDayAdd + 1
End If
Loop
End If
GetBusinessDay = datStart
Exit_Here:
rst.Close
Set rst = Nothing
Set DB = Nothing
Exit Function
Error_Handler:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Here
End Function
Public Function Process_Date(ProcDate As Date) As Date
Dim ProcessDate As Date
'This is an attempt to get Process date in so that if an old report is needed
it will give accurate information
ProcessDate = FormatDateTime(ProcDate, vbShortDate)
Process_Date = ProcessDate
End Function
Public Function GetWorkDay(dtDate As Variant) As Variant
Dim WkDay As Integer
WkDay = Weekday(dtDate)
If WkDay = 7 Then
'return friday's date
GetWorkDay = DateAdd("d", -1, dtDate)
ElseIf WkDay = 1 Then
'return friday's date
GetWorkDay = DateAdd("d", -2, dtDate)
Else
GetWorkDay = dtDate
End If
End Function
Function UpBusDays3(pStart As Date, _
pnum As Integer, _
Optional pAdd As Boolean = True) As Date
'*******************************************
'Purpose: Add or subtract business days
' from a date
'Coded by: raskew of Accessmonster.com
'Inputs: +) ? UpBusDays3(#2/17/06#, 3, True)
' -) ? UpBusDays3(#2/22/06#, 3, False)
'Output: +) 2/22/06
' -) 2/17/06
'*******************************************
Dim dteHold As Date
Dim I As Integer
Dim n As Integer
dteHold = pStart
n = pnum
For I = 1 To n
If pAdd Then 'add days
dteHold = dteHold + IIF(Weekday(dteHold) > 5, 9 - Weekday(dteHold),
1)
Else 'subtract days
'this isn't working for Sunday
dteHold = dteHold - IIF(Weekday(dteHold) < 3, Choose(Weekday(dteHold)
, 2, 3), 1)
End If
Next I
UpBusDays3 = dteHold
End Function
I have a user defined function (Below) that when its run it returning an
Unknown Jet Error. I know that the information going into it is valid.
Would someone pleae able to take a look at the code and see if their is an
validation rule that is being violated that I'm just not seeing? Thanks.
Option Compare Database
Public Function fncDueDate(pFrequency As String, pDays As Variant, Procdt As
Date) As Variant
'This is the main module for the remit date function
'This module will call on modules to calculate for "BD" "CD" "Daily" "FCD"
and "Other"/"Exceptions"
Dim Dailyjkr As Date
Dailyjkr = Procdt - 1
If IsNull(pFrequency) Or IsNull(pDays) Then
fncDueDate = Null
Else
Select Case pFrequency
' Case Null
' IsNull
Case "BD"
GoTo BDFunk 'Call Function BDFunk
Case "CD"
GoTo CDFunk 'Call Function CDFunk
Case "Daily" 'Daily only returns the current date. This is because
the remittance would drop last night with 1BD making it today.
GoTo Daily
Case "FCD"
GoTo FCDFunk 'Call Function for FCD
'*************************************************************************************************
'*************************************EXCEPTIONS**************************************************
'**************************ADD HERE ANY ODD REMIT/PAYOFF
DATES************************************
Case "3BD prior to 18th"
GoTo THREEBD18TH 'Call function THREEBD18TH to calculate 3
business days prior to the 18th
Case Else
fncDueDate = Null 'If the remittance frequency doesn't match any
of the above it will result null to make it easier to find new exceptions
GoTo Batcave
End Select
End If
'---------------------------------------DAILY---------------------------------
---------------------
Daily:
fncDueDate = GetBusinessDay(Dailyjkr + 1, 1) 'this just sets it to the next
business day
'fncDueDate = Dailyjkr
GoTo Batcave
'---------------------------------------Calendar days-------------------------
---------------------
CDFunk:
If Day(Procdt) > pDays Then 'Is the day that it should be remitted
already past for this month? If so go to next month
fncDueDate = DateAdd("m", 1, Procdt) 'add one month
fncDueDate = DateSerial(Year([fncDueDate]), Month([fncDueDate]), Day(
[pDays]) + 1) 'set the date static
DateValue (fncDueDate) 'this is to make sure that the value remains a
date
fncDueDate = GetWorkDay(fncDueDate) 'runs the function that if the
day falls on a weekend/holiday it will go back to the previous weekday
GoTo Batcave
Else
fncDueDate = Procdt 'this is the starting point giving it a date
fncDueDate = DateSerial(Year(fncDueDate), Month([fncDueDate]), Day
(pDays) + 1) 'set the date static
fncDueDate = FormatDateTime(fncDueDate, vbShortDate) 'formats date as
short date
DateValue (fncDueDate) 'this makes sure that it is in date format
fncDueDate = GetWorkDay(fncDueDate) 'runs the function that if the
day falls on a weekend/holiday it will go back to the previous weekday
GoTo Batcave
GoTo Batcave
End If
'---------------------------------------Business Days-------------------------
---------------------
BDFunk:
fncDueDate = GetBusinessDay(Dailyjkr + 1, pDays) 'This just adds whatever
number is in tbl_RemitDays!Days to the current day using only business days
(HOLIDAYS NOT INCLUDED)
GoTo Batcave
'---------------------------------------Floating Calendar Days----------------
---------------------
FCDFunk:
fncDueDate = Procdt
fncDueDate = DateSerial(Year(fncDueDate), Month([fncDueDate]), Day
(fncDueDate) + pDays) 'this adds however many days to the process date
fncDueDate = FormatDateTime(fncDueDate, vbShortDate)
DateValue (fncDueDate) 'this makes sure that it is in date format
fncDueDate = GetWorkDay(fncDueDate) 'runs the function that if the
day falls on a weekend/holiday it will go back to the previous weekday
GoTo Batcave
'*************************************************************************************************
'*************************************EXCEPTIONS**************************************************
'**************************ADD HERE ANY ODD REMIT/PAYOFF
DATES************************************
THREEBD18TH:
If Day(18) > pDays Then 'Is the day that it should be remitted already
past for this month? If so go to next month
fncDueDate = DateAdd("m", 1, Procdt) 'add one month
fncDueDate = Procdt
fncDueDate = UpBusDays3(DateSerial(Year(fncDueDate), Month([fncDueDate]), Day
(18) + 1), 3, False)
Else
fncDueDate = Procdt
fncDueDate = UpBusDays3(DateSerial(Year(fncDueDate), Month([fncDueDate]), Day
(18) + 1), 3, False)
End If
GoTo Batcave
'*************************************************************************************************
Batcave: 'this just exits the code
FormatDateTime (fncDueDate)
fncDueDate = fncDueDate
'End Select
End Function
Function GetBusinessDay(datStart As Date, intDayAdd As Variant)
On Error GoTo Error_Handler
'Adds/Subtracts the proper Business day skipping holidays and weekends
'Requires a table (tblHolidays) with a date field (HolidayDate)
'Arvin Meyer 05/26/98 revised 3/12/2002
'© Arvin Meyer 1998 - 2002 You may use this code in your application provided
author
' is given credit. This code may not be distributed as part of a collection
' without prior written permission. This header must remain intact.
Dim rst As DAO.Recordset
Dim DB As DAO.Database
'Dim strSQL As String
Set DB = CurrentDb
Set rst = DB.OpenRecordset("SELECT [HolidayDate] FROM tblHolidays",
dbOpenSnapshot)
If intDayAdd > 0 Then
Do While intDayAdd > 0
datStart = datStart + 1
rst.FindFirst "[HolidayDate] = #" & datStart & "#"
If Weekday(datStart) <> vbSunday And Weekday(datStart) <> vbSaturday
Then
If rst.NoMatch Then intDayAdd = intDayAdd - 1
End If
Loop
ElseIf intDayAdd < 0 Then
Do While intDayAdd < 0
datStart = datStart - 1
rst.FindFirst "[HolidayDate] = #" & datStart & "#"
If Weekday(datStart) <> vbSunday And Weekday(datStart) <> vbSaturday
Then
If rst.NoMatch Then intDayAdd = intDayAdd + 1
End If
Loop
End If
GetBusinessDay = datStart
Exit_Here:
rst.Close
Set rst = Nothing
Set DB = Nothing
Exit Function
Error_Handler:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Here
End Function
Public Function Process_Date(ProcDate As Date) As Date
Dim ProcessDate As Date
'This is an attempt to get Process date in so that if an old report is needed
it will give accurate information
ProcessDate = FormatDateTime(ProcDate, vbShortDate)
Process_Date = ProcessDate
End Function
Public Function GetWorkDay(dtDate As Variant) As Variant
Dim WkDay As Integer
WkDay = Weekday(dtDate)
If WkDay = 7 Then
'return friday's date
GetWorkDay = DateAdd("d", -1, dtDate)
ElseIf WkDay = 1 Then
'return friday's date
GetWorkDay = DateAdd("d", -2, dtDate)
Else
GetWorkDay = dtDate
End If
End Function
Function UpBusDays3(pStart As Date, _
pnum As Integer, _
Optional pAdd As Boolean = True) As Date
'*******************************************
'Purpose: Add or subtract business days
' from a date
'Coded by: raskew of Accessmonster.com
'Inputs: +) ? UpBusDays3(#2/17/06#, 3, True)
' -) ? UpBusDays3(#2/22/06#, 3, False)
'Output: +) 2/22/06
' -) 2/17/06
'*******************************************
Dim dteHold As Date
Dim I As Integer
Dim n As Integer
dteHold = pStart
n = pnum
For I = 1 To n
If pAdd Then 'add days
dteHold = dteHold + IIF(Weekday(dteHold) > 5, 9 - Weekday(dteHold),
1)
Else 'subtract days
'this isn't working for Sunday
dteHold = dteHold - IIF(Weekday(dteHold) < 3, Choose(Weekday(dteHold)
, 2, 3), 1)
End If
Next I
UpBusDays3 = dteHold
End Function