Option Compare Database
Option Explicit


Sub FlaechenbindungenBerechnen(Jahr1 As Long)

Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim temptablename1 As String
Dim oldMGNR As Long
Dim countit As Boolean
Dim summe As Double
temptablename1 = "xTempFlaechenbindungen"

Set db1 = CurrentDb

Set db1 = CurrentDb
If TableExists(temptablename1) Then
 db1.Execute ("DROP TABLE " + temptablename1)
End If
db1.Execute ("CREATE TABLE " + temptablename1 + " (MGNR LONG, Gesamtflaeche DOUBLE);")
Set rs1 = db1.OpenRecordset("SELECT * FROM TFlaechenbindungen ORDER BY MGNR")
Set rs2 = db1.OpenRecordset(temptablename1)
oldMGNR = -1
While Not rs1.EOF
 If oldMGNR <> rs1("MGNR") Then
  If oldMGNR <> -1 Then
   rs2("MGNR") = oldMGNR
   rs2("Gesamtflaeche") = summe
   rs2.Update
  End If
  rs2.AddNew
  summe = 0
 End If
 
 countit = True
 If IsNull(rs1("Von")) Then
 Else
  If rs1("Von") <= Jahr1 Then
  Else
   countit = False
  End If
 End If
  
 If IsNull(rs1("Bis")) Then
 Else
  If rs1("Bis") >= Jahr1 Then
  Else
   countit = False
  End If
 End If
 
 If IsNull(rs1("Flaeche")) Then
  countit = False
 End If
  
 If countit Then
  summe = summe + rs1("Flaeche")
 End If
 oldMGNR = rs1("MGNR")
 rs1.MoveNext
Wend
rs2.Update
rs1.Close
rs2.Close

End Sub



Function TableExists(table1) As Boolean

Dim db1 As Database
Set db1 = CurrentDb
Dim x As TableDef

For Each x In db1.TableDefs
 If x.Name = table1 Then
   TableExists = True
   Exit Function
 End If
Next x

   TableExists = False

End Function