我需要的Microsoft Access的dateReceived场到firstFollowUp领域我的形式后生成日期8个工作日

问题描述 投票:0回答:2

我有其中具有接收到的文书工作的时间处理以便文书工作I输入信息的形式。我需要它来生成8个工作日的日期(在一个名为firstFollowUp新场),所以我知道,当我有打电话跟进文书工作的状态。我主要是熟悉VBA,但我接受其他的建议。

这是我目前有,但我不断收到关于格式的行语法错误。另外,我不知道该做什么,我想它。

Function Work_Days(dateReceived As Variant, firstFollowUp As Variant) As 
Long

Dim wholeWeeks As Variant
Dim dateCount As Variant
Dim endDays As Integer

wholeWeeks = DateDiff("w", dateReceived, firstFollowUp)
dateCount = DateAdd("ww", wholeWeeks, dateReceived)
endDays = 0

Do While dateCount <= firstFollowUp
    If Format(dateCount, "ddd")<> "Sun" And
        Format(dateCount, "ddd")<> "Sat" Then

            endDays = endDays + 1
    End If

    dateCount = DateAdd("d", 1, dateCount)
Loop
Work_Days = wholeWeeks * 5 + endDays

Exit Function
ms-access access-vba
2个回答
0
投票

假设DatePaperworkReceived是对“文书工作收到日期”你的表单控件,将其添加到“更新后”事件DatePaperworkReceived

Me.firstFollowUp =使用DateAdd( 'd',8,Me.DatePaperworkreceived)

对于工作日,而不是8,你可以使用:

IIf(Weekday(Me.DatePaperworkreceived)=7,13,IIF(Weekday(Me.DatePaperworkreceived)>3,12,10))

如果你放心接收的日期也不会落在它可以简化周末:

IIF(Weekday(Me.DatePaperworkreceived)>3,12,10)

0
投票

我在我以前的Access应用程序代码,它计算下一个营业日一经发现,但我不知道我在哪里有它。积分去谁做的编码器。我可能是有用的:

Option Compare Database
Option Explicit

Public Function AddWorkDaysA(lngDays As Long, _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant) As Date
    ' Add the specified number of work days to the
    ' specified date.

    ' In:
    '   lngDays:
    '       Number of work days to add to the start date.
    '   dtmDate:
    '       date on which to start looking.
    '       Use the current date, if none was specified.
    '   adtmDates (Optional):
    '       Array containing holiday dates. Can also be a single
    '       date value, if that's what you want.
    ' Out:
    '   Return Value:
    '       The date of the working day lngDays from the start, taking
    '       into account weekends and holidays.
    ' Example:
    '   AddWorkDaysA(10, #2/9/2019#, Array(#2/18/2019#, #2/20/2019#))
    '   returns #2/26/2019#, which is the date 10 work days
    '   after 2/9/2019, if you treat 2/18 and 2/20 as holidays


    ' Did the caller pass in a date? If not, use
    ' the current date.
    Dim lngCount As Long
    Dim dtmTemp As Date

    If dtmDate = 0 Then
        dtmDate = Date
    End If

    dtmTemp = dtmDate
    For lngCount = 1 To lngDays
        dtmTemp = NextWorkdayA(dtmTemp, adtmDates)
    Next lngCount
    AddWorkDaysA = dtmTemp
End Function

Public Function NextWorkdayA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date

    ' Return the next working day after the specified date.

    ' In:
    '   dtmDate:
    '       date on which to start looking.
    '       Use the current date, if none was specified.
    '   adtmDates (Optional):
    '       Array containing holiday dates. Can also be a single
    '       date value.
    ' Out:
    '   Return Value:
    '       The date of the next working day, taking
    '       into account weekends and holidays.
    ' Example:
    '   ' Find the next working date after 5/24/19
    '   dtmDate = NextWorkdayA(#5/24/19#, #5/27/19#)
    '   ' dtmDate should be 5/28/19, because 5/27/19 is Memorial day.

    ' Did the caller pass in a date? If not, use
    ' the current date.
    If dtmDate = 0 Then
        dtmDate = Date
    End If

    NextWorkdayA = SkipHolidaysA(adtmDates, dtmDate + 1, 1)
End Function

Private Function SkipHolidaysA( _
adtmDates As Variant, _
dtmTemp As Date, intIncrement As Integer) As Date
    ' Skip weekend days, and holidays in the array referred to by adtmDates.
    ' Return dtmTemp + as many days as it takes to get to a day that's not
    ' a holiday or weekend.

    Dim strCriteria As String
    Dim strFieldName As String
    Dim lngItem As Long
    Dim blnFound As Boolean

    On Error GoTo HandleErrors

    ' Move up to the first Monday/last Friday, if the first/last
    ' of the month was a weekend date. Then skip holidays.
    ' Repeat this entire process until you get to a weekday.
    ' Unless adtmDates an item for every day in the year (!)
    ' this should finally converge on a weekday.

    Do
        Do While IsWeekend(dtmTemp)
            dtmTemp = dtmTemp + intIncrement
        Loop
        Select Case VarType(adtmDates)
            Case vbArray + vbDate, vbArray + vbVariant
                Do
                    blnFound = FindItemInArray(dtmTemp, adtmDates)
                    If blnFound Then
                        dtmTemp = dtmTemp + intIncrement
                    End If
                Loop Until Not blnFound
            Case vbDate
                If dtmTemp = adtmDates Then
                    dtmTemp = dtmTemp + intIncrement
                End If
        End Select
    Loop Until Not IsWeekend(dtmTemp)

ExitHere:
    SkipHolidaysA = dtmTemp
    Exit Function

HandleErrors:
    Resume ExitHere
End Function

Private Function IsWeekend(dtmTemp As Variant) As Boolean
    ' If your weekends aren't Saturday (day 7) and Sunday (day 1),
    ' change this routine to return True for whatever days
    ' you DO treat as weekend days.

    If VarType(dtmTemp) = vbDate Then
        Select Case Weekday(dtmTemp)
            Case vbSaturday, vbSunday
                IsWeekend = True
            Case Else
                IsWeekend = False
        End Select
    End If
End Function

Private Function FindItemInArray(varItemToFind As Variant, _
avarItemsToSearch As Variant) As Boolean
    Dim lngItem As Long

    On Error GoTo HandleErrors

    For lngItem = LBound(avarItemsToSearch) To UBound(avarItemsToSearch)
        If avarItemsToSearch(lngItem) = varItemToFind Then
            FindItemInArray = True
            GoTo ExitHere
        End If
    Next lngItem

ExitHere:
    Exit Function

HandleErrors:
    Resume ExitHere
End Function

只要使用这样的:

 firstFollowUp.Text = AddWorkDaysA (8, yourDateFiled.Text, Array(#1/1/2019#, #2/18/2019#, #5/27/2019#, #4/4/2019#))
© www.soinside.com 2019 - 2024. All rights reserved.