Function kalender_tab(dat_von As Date, dat_bis As Date, tabname$)
'Autor: Heiko Hommes
'Datum:
'Beschr: hier wird eine Tabelle erstellt, welche diese dann
'         mit fortlaufendem Datum für den angegebenen Zeitraum
'           füllt.

On Error GoTo fehler

Dim db As Database
Dim rs As Recordset
Dim tdf_new As TableDef
Dim erster_tag As Long
Dim erster_tag_d As Date

Dim letzter_tag As Long
Dim startjahr%
Dim endjahr%
Dim ycounter%
Dim mcounter%
Dim dcounter%

weiter:
Set db = DBEngine(0)(0)

'Neue Tabelle erstellen
Set tdf_new = db.CreateTableDef(tabname)


'Felder deklarieren
With tdf_new
    .Fields.Append .CreateField("Datum", dbDate)
    
    'Felder hinzufügen

    db.TableDefs.Append tdf_new
End With


startjahr = Year(dat_von)
endjahr = Year(dat_bis)
ycounter = 0
mcounter = 0
dcounter = 0

Set rs = db.OpenRecordset(tabname)
For ycounter = startjahr To endjahr Step 1
    For mcounter = Month(dat_von) To 12 Step 1
        erster_tag_d = Format(Str(Day(dat_von)) & "." & Str(mcounter) & "." & Str(ycounter), "d.mm.yyyy")
        erster_tag = Day(erster_tag_d - Day(erster_tag_d) + 1)
        letzter_tag = Day(DateSerial(Year(erster_tag_d), Month(erster_tag_d) + 1, 0))
         
        For dcounter = erster_tag To letzter_tag Step 1
            rs.AddNew
            rs![datum] = Format(Str(dcounter) & "." & Str(mcounter) & "." & Str(ycounter), "d.m.yy")
            rs.Update
        Next dcounter
    Next mcounter
Next ycounter
'erster_tag = Datum() - Tag(Datum()) + 1
'letzter_tag = DatSeriell(Jahr(Datum()), Monat(Datum()) + 1, 0)


Exit Function

fehler:
If Err.Number = 3010 Then
    db.TableDefs.Delete tabname
   GoTo weiter
End If
msgbox (Err.Number & Err.Description)
Exit Function

End Function