Question

我有一张表格，其中我输入了收到文书工作之日处理的文书工作的信息。我需要它在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

Answer 1

假设DatePaperworkReceived是“收到文件的日期”的表单控件，请将其添加到DatePaperworkReceived的“ AfterUpdate”事件中。

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)

Answer 2

我在一个旧的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#))

我需要Microsoft Access在表单上的firstFollowUp字段中将dateReceived字段后的8个工作日生成日期

2 个答案: