Weekender ud af periode

Jeg håbede der var en forud defineret funktion?
Ellers forestiller jeg mig at man skal i VB lave en slags loop der skriver alle datoerne op, og via weekday trække lørdage og søndage ud..?
Nogen bud? Hvis nogen har VB-koden i forvejen ville jeg sætte stor pris på det!

Her er en række funktioner, som du kan bruge til at beregne noget med arbejdsdage:
http://www.mvps.org/access/datetime/date0012.htm

Den du er ude efter er denne:


Public Function dhCountWorkdaysA(ByVal dtmStart As Date, ByVal dtmEnd As Date, _
Optional adtmDates As Variant = Empty) _
As Integer

    ' Count the business days (not counting weekends/holidays) in
    ' a given date range.
   
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
   
    ' Requires:
    '  SkipHolidays
    '  CountHolidays
    '  IsWeekend
   
    ' In:
    '  dtmStart:
    '      Date specifying the start of the range (inclusive)
    '  dtmEnd:
    '      Date specifying the end of the range (inclusive)
    '      (dates will be swapped if out of order)
    '  adtmDates (Optional):
    '      Array containing holiday dates. Can also be a single
    '      date value.
    ' Out:
    '  Return Value:
    '      Number of working days (not counting weekends and optionally, holidays)
    '      in the specified range.
    ' Example:
    '  Debug.Print dhCountWorkdaysA(#7/2/2000#, #7/5/2000#, _
    '    Array(#1/1/2000#, #7/4/2000#))
    '
    '  returns 2, because 7/2/2000 is Sunday, 7/4/2000 is a holiday,
    '  leaving 7/3 and 7/5 as workdays.
   
    Dim intDays As Integer
    Dim dtmTemp As Date
    Dim intSubtract As Integer
   
    ' Swap the dates if necessary.>
    If dtmEnd < dtmStart Then
        dtmTemp = dtmStart
        dtmStart = dtmEnd
        dtmEnd = dtmTemp
    End If
   
    ' Get the start and end dates to be weekdays.
    dtmStart = SkipHolidaysA(adtmDates, dtmStart, 1)
    dtmEnd = SkipHolidaysA(adtmDates, dtmEnd, -1)
    If dtmStart > dtmEnd Then
        ' Sorry, no Workdays to be had. Just return 0.
        dhCountWorkdaysA = 0
    Else
        intDays = dtmEnd - dtmStart + 1
       
        ' Subtract off weekend days.  Do this by figuring out how
        ' many calendar weeks there are between the dates, and
        ' multiplying the difference by two (because there are two
        ' weekend days for each week). That is, if the difference
        ' is 0, the two days are in the same week. If the
        ' difference is 1, then we have two weekend days.
        intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2)
       
        ' The answer to our quest is all the weekdays, minus any
        ' holidays found in the table.
        intSubtract = intSubtract + _
        CountHolidaysA(adtmDates, dtmStart, dtmEnd)
       
        dhCountWorkdaysA = intDays - intSubtract
    End If
End Function

Du kan bruge denne i en forespørgsel. Den returnerer en numerisk værdi svarende til ugedagen. Derefter kan du indsætte et kriterie der frasoereter LØR og SØN

Og her kommer den så.

Udtryk6: Weekday([Dato1])

Dato1 er dit feltnavn

Hej igen
Jesper jeg har prøvet at få din funktion til at virke, men..

Jeg har copy/patet hele molevitten ind i mit module1

(Tabellen Afbrud samler data om afbrud inkl start og slutdato)
Så har jeg lavet en form med følgende i Record Source:
SELECT Afbrud.*, dhCountWorkdaysA([AfbrudsdatoStart],[AfbrudsdatoSlut]) AS Expr1 FROM Afbrud;

Der går helt ged i VBA compileren hver gang, og det sker ved linjen:
dtmStart = SkipHolidaysA(adtmDates, dtmStart, 1)

Gør jeg noget forkert?

Nå ja, du skal klippe hele den nedenstående kodeklump ind i din database. Så har du funktionerne tilgængelige.
Den er lidt lang men kommer her nedenfor, så kan du tage den derfra.
Sæt det ind i et modul i databasen.

Bagefter kan du beregne antallet af dage mellem to datoer sådan:

Antal = dhCountWorkdaysA("01-01-2005","10-02-2005")
(denne giver 29)


' ********* Code Start **************
'
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
'

Public Function dhAddWorkDaysA(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.
   
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
   
    ' 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:
    '  dhAddWorkDaysA(10, #2/9/2000#, Array(#2/16/2000#, #2/17/2000#))
    '  returns #2/25/2000#, which is the date 10 work days
    '  after 2/9/2000, if you treat 2/16 and 2/17 as holidays
    '  (just made-up holidays, for example purposes only).
   
    ' 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 = dhNextWorkdayA(dtmTemp, adtmDates)
    Next lngCount
    dhAddWorkDaysA = dtmTemp
End Function

Public Function dhNextWorkdayA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
   
    ' Return the next working day after the specified date.
   
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
   
    ' Requires:
    '  SkipHolidays
    '  IsWeekend
   
    ' 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/30/97
    '  dtmDate = dhNextWorkdayA(#5/23/1997#, #5/26/97#)
    '  ' dtmDate should be 5/27/97, because 5/26/97 is Memorial day.
   
    ' Did the caller pass in a date? If not, use
    ' the current date.
    If dtmDate = 0 Then
        dtmDate = Date
    End If
   
    dhNextWorkdayA = SkipHolidaysA(adtmDates, dtmDate + 1, 1)
End Function

Public Function dhPreviousWorkdayA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
   
    ' Return the previous working day before the specified date.
   
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
   
    ' Requires:
    '  SkipHolidays
    '  IsWeekend
   
    ' 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 previous working day, taking
    '      into account weekends and holidays.
    ' Example:
    '  ' Find the next working date before 1/1/2000
   
    '  dtmDate = dhPreviousWorkdayA(#1/1/2000#, Array(#12/31/1999#, #1/1/2000#))
    '  ' dtmDate should be 12/30/1999, because of the New Year's holidays.
   
    ' Did the caller pass in a date? If not, use
    ' the current date.
    If dtmDate = 0 Then
        dtmDate = Date
    End If
   
    dhPreviousWorkdayA = SkipHolidaysA(adtmDates, dtmDate - 1, -1)
End Function

Public Function dhFirstWorkdayInMonthA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
   
    ' Return the first working day in the month specified.
   
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
   
    ' Requires:
    '  SkipHolidays
    '  IsWeekend
   
    ' In:
    '  dtmDate:
    '      date within the month of interest.
    '      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 first working day in the month, taking
    '      into account weekends and holidays.
    ' Example:
    '  ' Find the first working day in 1999
    '  dtmDate = dhFirstWorkdayInMonthA(#1/1/1999#, #1/1/1999#)
   
    Dim dtmTemp As Date
   
    ' Did the caller pass in a date? If not, use
    ' the current date.
    If dtmDate = 0 Then
        dtmDate = Date
    End If
   
    dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate), 1)
    dhFirstWorkdayInMonthA = SkipHolidaysA(adtmDates, dtmTemp, 1)
End Function

Public Function dhLastWorkdayInMonthA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
   
    ' Return the last working day in the month specified.
   
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
   
    ' Requires:
    '  SkipHolidays
    '  IsWeekend
   
    ' In:
    '  dtmDate:
    '      date within the month of interest.
    '      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 last working day in the month, taking
    '      into account weekends and holidays.
    ' Example:
    '  ' Find the last working day in 1999
    '  dtmDate = dhLastWorkdayInMonthA(#12/1/1999#, #12/31/1999#)
   
    Dim dtmTemp As Date
   
    ' Did the caller pass in a date? If not, use
    ' the current date.
    If dtmDate = 0 Then
        dtmDate = Date
    End If
   
    dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0)
    dhLastWorkdayInMonthA = SkipHolidaysA(adtmDates, dtmTemp, -1)
End Function

Public Function dhCountWorkdaysA(ByVal dtmStart As Date, ByVal dtmEnd As Date, _
Optional adtmDates As Variant = Empty) _
As Integer

    ' Count the business days (not counting weekends/holidays) in
    ' a given date range.
   
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
   
    ' Requires:
    '  SkipHolidays
    '  CountHolidays
    '  IsWeekend
   
    ' In:
    '  dtmStart:
    '      Date specifying the start of the range (inclusive)
    '  dtmEnd:
    '      Date specifying the end of the range (inclusive)
    '      (dates will be swapped if out of order)
    '  adtmDates (Optional):
    '      Array containing holiday dates. Can also be a single
    '      date value.
    ' Out:
    '  Return Value:
    '      Number of working days (not counting weekends and optionally, holidays)
    '      in the specified range.
    ' Example:
    '  Debug.Print dhCountWorkdaysA(#7/2/2000#, #7/5/2000#, _
    '    Array(#1/1/2000#, #7/4/2000#))
    '
    '  returns 2, because 7/2/2000 is Sunday, 7/4/2000 is a holiday,
    '  leaving 7/3 and 7/5 as workdays.
   
    Dim intDays As Integer
    Dim dtmTemp As Date
    Dim intSubtract As Integer
   
    ' Swap the dates if necessary.>
    If dtmEnd < dtmStart Then
        dtmTemp = dtmStart
        dtmStart = dtmEnd
        dtmEnd = dtmTemp
    End If
   
    ' Get the start and end dates to be weekdays.
    dtmStart = SkipHolidaysA(adtmDates, dtmStart, 1)
    dtmEnd = SkipHolidaysA(adtmDates, dtmEnd, -1)
    If dtmStart > dtmEnd Then
        ' Sorry, no Workdays to be had. Just return 0.
        dhCountWorkdaysA = 0
    Else
        intDays = dtmEnd - dtmStart + 1
       
        ' Subtract off weekend days.  Do this by figuring out how
        ' many calendar weeks there are between the dates, and
        ' multiplying the difference by two (because there are two
        ' weekend days for each week). That is, if the difference
        ' is 0, the two days are in the same week. If the
        ' difference is 1, then we have two weekend days.
        intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2)
       
        ' The answer to our quest is all the weekdays, minus any
        ' holidays found in the table.
        intSubtract = intSubtract + _
        CountHolidaysA(adtmDates, dtmStart, dtmEnd)
       
        dhCountWorkdaysA = intDays - intSubtract
    End If
End Function

Private Function CountHolidaysA( _
adtmDates As Variant, _
dtmStart As Date, dtmEnd As Date) As Long

    ' Count holidays between two end dates.
    '
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
   
    ' Required by:
    '  dhCountWorkdays
   
    ' Requires:
    '  IsWeekend
   
   
    Dim lngItem As Long
    Dim lngCount As Long
    Dim blnFound As Long
    Dim dtmTemp As Date
   
    On Error GoTo HandleErr
    lngCount = 0
    Select Case VarType(adtmDates)
        Case vbArray + vbDate, vbArray + vbVariant
            ' You got an array of variants, or of dates.
            ' Loop through, looking for non-weekend values
            ' between the two endpoints.
            For lngItem = LBound(adtmDates) To UBound(adtmDates)
                dtmTemp = adtmDates(lngItem)
                If dtmTemp >= dtmStart And dtmTemp <= dtmEnd Then
                    If Not IsWeekend(dtmTemp) Then
                        lngCount = lngCount + 1
                    End If
                End If
            Next lngItem
        Case vbDate
            ' You got one date. So see if it's a non-weekend
            ' date between the two endpoints.
            If adtmDates >= dtmStart And adtmDates <= dtmEnd Then
                If Not IsWeekend(adtmDates) Then
                    lngCount = 1
                End If
            End If
    End Select

ExitHere:
    CountHolidaysA = lngCount
    Exit Function
   
HandleErr:
    ' No matter what the error, just
    ' return without complaining.
    ' The worst that could happen is that the code
    ' include a holiday as a real day, even if
    ' it's in the table.
    Resume ExitHere
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:
    ' Do nothing at all.
    ' Return False.
    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.
   
    ' Modified from code in "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
   
    ' Required by:
    '  SkipHolidays
    '  dhFirstWorkdayInMonth
    '  dbLastWorkdayInMonth
    '  dhNextWorkday
    '  dhPreviousWorkday
    '  dhCountWorkdays
   
    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 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.
   
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
   
    ' Required by:
    '  dhFirstWorkdayInMonthA
    '  dbLastWorkdayInMonthA
    '  dhNextWorkdayA
    '  dhPreviousWorkdayA
    '  dhCountWorkdaysA
   
    ' Requires:
    '  IsWeekend
   
    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:
    ' No matter what the error, just
    ' return without complaining.
    ' The worst that could happen is that we
    ' include a holiday as a real day, even if
    ' it's in the array.
    Resume ExitHere
End Function
' ********* Code End **************

Tak Jesper!
Der virker PERFEKT!
Men sikke en lang kode.. :-(  Godt jeg ikke selv begyndte at rode med det, så var jeg aldrig kommet igennem det..

Selv tak.
Jeg skal skynde mig at sige at jeg blot har sakset det fra ovenstående adresse.
Og i al den kode er der jo flere forskellige funktioner:

dhNextWorkdayA 
dhPreviousWorkDayA
dhFirstWorkdayInMonthA
dhLastWorkdayInMonthA
dhAddWorkDaysA
dhCountWorkdaysA
CountHolidaysA

Navnene forklarer mere eller mindre sig selv.
Ellers er der små forklaringer indlejret i koden.
Det kan være du kan bruge noget af det i din database.