Private Sub BOk_Click()

DoCmd.Hourglass True
ImportLieferungen TImportFile
ImportMitglieder TImportFile
ImportChargen TImportFile
DoCmd.Hourglass False
SetParameter "ImportPfad", TImportFile
DoCmd.Close


End Sub


Sub ImportLieferungen(filename As String)

Dim db1 As Database
Dim rs1 As Recordset
Dim db2 As Database
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim item1 As Integer

Dim tempfilename1 As String
Dim filename1 As String
Dim tempfilename2 As String
Dim filename2 As String
Dim query1 As String
Dim query2 As String
Dim Lesejahr1 As Long
Dim ZNR1 As Long
Dim newLINR As Long
Dim oldLINR As Long
Dim newFBNR As Long

Dim endwhile1

' get lesejahr1/znr1

 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 
 On Error GoTo TableNotFound
 
 If IsNull(db1.TableDefs("xTLieferungen")) Then Exit Sub
 
 Set rs1 = db1.OpenRecordset("xTLieferungen")
 
 ' TLieferungen does not exist
 If IsNull(rs1) Then Exit Sub
 
  Lesejahr1 = year(rs1!Datum)
  ZNR1 = rs1!ZNR
  rs1.Close
  db1.Close

'TLieferungen
 filename1 = "TLieferungen"
 tempfilename1 = "xTLieferungen"
 tempfilename2 = "xTLieferungAbschlag"
 filename2 = "TLieferungAbschlag"

 query1 = "SELECT * FROM xTLieferungen ORDER BY LINR"
 query2 = "SELECT * FROM xTLieferungAbschlag ORDER BY LINR"
 
 DoCmd.Hourglass False
If MsgBox("Sollen vorhandene Lieferungen der Zweigstelle " + Format(ZNR1) + " vom Lesejahr " + Format(Lesejahr1) + " eingelesen und überschrieben werden ?", vbYesNo) = vbYes Then
  DoCmd.Hourglass True
  Set db2 = CurrentDb
  db2.Execute ("DELETE TLieferungAbschlag.* FROM TLieferungAbschlag RIGHT JOIN TLieferungen ON TLieferungAbschlag.LINR = TLieferungen.LINR WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1) + ";")
  db2.Execute ("DELETE * FROM TLieferungen WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1) + ";")


 If IsNull(DMax("LINR", "TLieferungen")) Then
  newLINR = 0
 Else
  newLINR = DMax("LINR", "TLieferungen")
 End If
 
 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 Set db2 = CurrentDb
 
 Set rs1 = db1.OpenRecordset(query1, dbOpenSnapshot)
 Set rs2 = db2.OpenRecordset(filename1, dbOpenDynaset, dbAppendOnly)
 Set rs3 = db1.OpenRecordset(query2, dbOpenSnapshot)
 Set rs4 = db2.OpenRecordset(filename2, dbOpenDynaset, dbAppendOnly)

 While Not rs1.EOF
 
  ' Insert TLieferungen
  newLINR = newLINR + 1
  rs2.AddNew

  
  For item1 = 0 To db1.TableDefs(tempfilename1).Fields.Count - 1
   rs2(item1) = rs1(item1)
  Next item1
  
  oldLINR = rs1!LINR
  rs2!LINR = newLINR
  rs2.Update


  ' Insert TLieferungAbschlag and substitute new LINR

  endwhile1 = 0
  While endwhile1 = 0
   If rs3.EOF Then
    endwhile1 = 1
   Else
    If rs3!LINR >= oldLINR Then
     endwhile1 = 1
    Else
     rs3.MoveNext
    End If
   End If

  Wend
  
  endwhile1 = 0
  While endwhile1 = 0
   If rs3.EOF Then
    endwhile1 = 1
   Else
    If rs3!LINR = oldLINR Then
    
     rs4.AddNew
     For item1 = 0 To db1.TableDefs(tempfilename2).Fields.Count - 1
      rs4(item1) = rs3(item1)
     Next item1
   
     rs4!LINR = newLINR
     rs4.Update
     rs3.MoveNext

    Else
     endwhile1 = 1
    End If
   End If
   
  Wend
  
  rs1.MoveNext
 Wend
 
 DoCmd.Hourglass False
 MsgBox (Format(rs1.recordcount) + " Lieferungen importiert")
 DoCmd.Hourglass True

 rs1.Close
 rs2.Close
 rs3.Close
 rs4.Close
 db1.Close
 db2.Close
 

End If

Exit Sub

TableNotFound:

 Exit Sub

End Sub





Sub ImportMitglieder(filename As String)

Dim db1 As Database
Dim rs1 As Recordset
Dim db2 As Database
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim item1 As Integer

Dim tempfilename1 As String
Dim filename1 As String
Dim tempfilename2 As String
Dim filename2 As String
Dim query1 As String
Dim query2 As String
Dim Lesejahr1 As Long
Dim ZNR1 As Long
Dim newLINR As Long
Dim oldLINR As Long
Dim newFBNR As Long

Dim endwhile1

' get lesejahr1/znr1

 On Error GoTo TableNotFound

 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 Set rs1 = db1.OpenRecordset("xTMitglieder")
 If IsNull(rs1) Then Exit Sub
 
  ZNR1 = rs1!ZNR
  rs1.Close
  db1.Close


'TMitglieder
 filename1 = "TMitglieder"
 tempfilename1 = "xTMitglieder"
 tempfilename2 = "xTFlaechenbindungen"
 filename2 = "TFlaechenbindungen"

 query1 = "SELECT * FROM xTMitglieder ORDER BY MGNR"
 query2 = "SELECT * FROM xTFlaechenbindungen ORDER BY MGNR"
 
 DoCmd.Hourglass False
 
 If MsgBox("Sollen vorhandene Mitglieder der Zweigstelle " + Format(ZNR1) + " eingelesen und überschrieben werden ?", vbYesNo) = vbYes Then
  DoCmd.Hourglass True
  Set db2 = CurrentDb
  db2.Execute ("DELETE TFlaechenbindungen.* FROM TFlaechenbindungen RIGHT JOIN TMitglieder ON TFlaechenbindungen.MGNR = TMitglieder.MGNR WHERE ZNR=" + Format(ZNR1) + ";")
  db2.Execute ("DELETE * FROM TMitglieder WHERE ZNR=" + Format(ZNR1) + ";")
  

 
 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 Set db2 = CurrentDb
 
 Set rs1 = db1.OpenRecordset(tempfilename1)
 Set rs2 = db2.OpenRecordset(filename1)

 While Not rs1.EOF
  ' Insert TMitglieder
  rs2.AddNew
  
  For item1 = 0 To db1.TableDefs(tempfilename1).Fields.Count - 1
   rs2(item1) = rs1(item1)
  Next item1
  rs2.Update
  rs1.MoveNext
 Wend
 
 DoCmd.Hourglass False
 MsgBox (Format(rs1.recordcount) + " Mitglieder importiert")
 DoCmd.Hourglass True
 
 rs1.Close
 rs2.Close
 db1.Close
 db2.Close


 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 Set db2 = CurrentDb
 
 Set rs1 = db1.OpenRecordset(tempfilename2)
 Set rs2 = db2.OpenRecordset(filename2)

 If IsNull(DMax("FBNR", "TFlaechenbindungen")) Then
  newFBNR = 0
 Else
  newFBNR = DMax("FBNR", "TFlaechenbindungen")
 End If
 
 While Not rs1.EOF
  ' Insert TFlaechenbindungen
  newFBNR = newFBNR + 1
  rs2.AddNew
  
  For item1 = 0 To db1.TableDefs(tempfilename2).Fields.Count - 1
   rs2(item1) = rs1(item1)
  Next item1
  rs2!FBNR = newFBNR
  rs2.Update
  rs1.MoveNext
 Wend
 DoCmd.Hourglass False
 MsgBox (Format(rs1.recordcount) + " Flächenbindungen importiert")
  
 rs1.Close
 rs2.Close
 db1.Close
 db2.Close

 End If


Exit Sub

TableNotFound:

 Exit Sub

End Sub


Sub ImportChargen(filename As String)

Dim db1 As Database
Dim rs1 As Recordset
Dim db2 As Database
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim item1 As Integer

Dim tempfilename1 As String
Dim filename1 As String
Dim tempfilename2 As String
Dim filename2 As String
Dim query1 As String
Dim query2 As String
Dim Lesejahr1 As Long
Dim ZNR1 As Long
Dim newCNR As Long
Dim oldCNR As Long

Dim endwhile1

' get lesejahr1/znr1

 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 
 On Error GoTo TableNotFound
 
 If IsNull(db1.TableDefs("xTChargen")) Then Exit Sub
 
 Set rs1 = db1.OpenRecordset("xTChargen")
 
 ' TChargen does not exist
 If IsNull(rs1) Then Exit Sub
 
  Lesejahr1 = rs1!Jahrgang
  ZNR1 = rs1!ZNR
  rs1.Close
  db1.Close

'TChargen
 filename1 = "TChargen"
 tempfilename1 = "xTChargen"

 query1 = "SELECT * FROM xTChargen ORDER BY CNR"
 
 DoCmd.Hourglass False
If MsgBox("Sollen vorhandene Chargen der Zweigstelle " + Format(ZNR1) + " vom Lesejahr " + Format(Lesejahr1) + " eingelesen und überschrieben werden ?", vbYesNo) = vbYes Then
  DoCmd.Hourglass True
  Set db2 = CurrentDb
  db2.Execute ("DELETE * FROM TChargen WHERE ZNR=" + Format(ZNR1) + " AND Year(Jahrgang)=" + Format(Lesejahr1) + ";")

 If IsNull(DMax("CNR", "TChargen")) Then
  newCNR = 0
 Else
  newCNR = DMax("CNR", "TChargen")
 End If
 
 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 Set db2 = CurrentDb
 
 Set rs1 = db1.OpenRecordset(query1, dbOpenSnapshot)
 Set rs2 = db2.OpenRecordset(filename1, dbOpenDynaset, dbAppendOnly)
 
 While Not rs1.EOF
 
  ' Insert TChargen
  newCNR = newCNR + 1
  rs2.AddNew

  
  For item1 = 0 To db1.TableDefs(tempfilename1).Fields.Count - 1
   rs2(item1) = rs1(item1)
  Next item1
  
  oldCNR = rs1!CNR
  rs2!CNR = newCNR
  rs2.Update

  ' Change CNR in TLieferungen
  Set rs3 = db2.OpenRecordset("SELECT * FROM TLieferungen WHERE CNR=" + Format(oldCNR))
  While Not rs3.EOF
   rs3.Edit
   rs3("CNR") = newCNR
   rs3.Update
   rs3.MoveNext
  Wend
  rs3.Close
  
  rs1.MoveNext
 Wend
 
 DoCmd.Hourglass False
 MsgBox (Format(rs1.recordcount) + " Chargen importiert")
 DoCmd.Hourglass True

 rs1.Close
 rs2.Close
 db1.Close
 db2.Close
 

End If

Exit Sub

TableNotFound:

 Exit Sub

End Sub
















Sub ImportAll(filename As String)

Dim db1 As Database
Dim rs1 As Recordset
Dim db2 As Database
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim item1 As Integer

Dim tempfilename1 As String
Dim filename1 As String
Dim tempfilename2 As String
Dim filename2 As String
Dim query1 As String
Dim query2 As String
Dim Lesejahr1 As Long
Dim ZNR1 As Long
Dim newLINR As Long
Dim oldLINR As Long
Dim newFBNR As Long

Dim endwhile1

' get lesejahr1/znr1

 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 Set rs1 = db1.OpenRecordset("xTLieferungen")
 If IsNull(rs1) Then
 Else
  Lesejahr1 = year(rs1!Datum)
  ZNR1 = rs1!ZNR
  rs1.Close
  db1.Close
 End If

'TLieferungen
 filename1 = "TLieferungen"
 tempfilename1 = "xTLieferungen"
 tempfilename2 = "xTLieferungAbschlag"
 filename2 = "TLieferungAbschlag"

 query1 = "SELECT * FROM xTLieferungen ORDER BY LINR"
 query2 = "SELECT * FROM xTLieferungAbschlag ORDER BY LINR"
 
 DoCmd.Hourglass False
 
If MsgBox("Sollen vorhandene Lieferungen der Zweigstelle " + Format(ZNR1) + " vom Lesejahr " + Format(Lesejahr1) + " eingelesen und überschrieben werden ?", vbYesNo) = vbYes Then
  DoCmd.Hourglass True
  Set db2 = CurrentDb
  db2.Execute ("DELETE TLieferungAbschlag.* FROM TLieferungAbschlag RIGHT JOIN TLieferungen ON TLieferungAbschlag.LINR = TLieferungen.LINR WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1) + ";")
  db2.Execute ("DELETE * FROM TLieferungen WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1) + ";")


 
 newLINR = DMax("LINR", "TLieferungen")
 
 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 Set db2 = CurrentDb
 
 Set rs1 = db1.OpenRecordset(query1, dbOpenSnapshot)
 Set rs2 = db2.OpenRecordset(filename1, dbOpenDynaset, dbAppendOnly)
 Set rs3 = db1.OpenRecordset(query2, dbOpenSnapshot)
 Set rs4 = db2.OpenRecordset(filename2, dbOpenDynaset, dbAppendOnly)

 While Not rs1.EOF
 
  ' Insert TLieferungen
  newLINR = newLINR + 1
  rs2.AddNew

  
  For item1 = 0 To db1.TableDefs(tempfilename1).Fields.Count - 1
   rs2(item1) = rs1(item1)
  Next item1
  
  oldLINR = rs1!LINR
  rs2!LINR = newLINR
  rs2.Update


  ' Insert TLieferungAbschlag and substitute new LINR

  endwhile1 = 0
  While endwhile1 = 0
   If rs3.EOF Then
    endwhile1 = 1
   Else
    If rs3!LINR >= oldLINR Then
     endwhile1 = 1
    Else
     rs3.MoveNext
    End If
   End If

  Wend
  
  endwhile1 = 0
  While endwhile1 = 0
   If rs3.EOF Then
    endwhile1 = 1
   Else
    If rs3!LINR = oldLINR Then
    
     rs4.AddNew
     For item1 = 0 To db1.TableDefs(tempfilename2).Fields.Count - 1
      rs4(item1) = rs3(item1)
     Next item1
   
     rs4!LINR = newLINR
     rs4.Update
     rs3.MoveNext

    Else
     endwhile1 = 1
    End If
   End If
   
  Wend
  
  rs1.MoveNext
 Wend
 
 DoCmd.Hourglass False
 MsgBox (Format(rs1.recordcount) + " Lieferungen importiert")
 DoCmd.Hourglass True

 rs1.Close
 rs2.Close
 rs3.Close
 rs4.Close
 db1.Close
 db2.Close
 

End If




'TMitglieder
 filename1 = "TMitglieder"
 tempfilename1 = "xTMitglieder"
 tempfilename2 = "xTFlaechenbindungen"
 filename2 = "TFlaechenbindungen"

 query1 = "SELECT * FROM xTMitglieder ORDER BY MGNR"
 query2 = "SELECT * FROM xTFlaechenbindungen ORDER BY MGNR"
 
 DoCmd.Hourglass False
 
 If MsgBox("Sollen vorhandene Mitglieder der Zweigstelle " + Format(ZNR1) + " eingelesen und überschrieben werden ?", vbYesNo) = vbYes Then
  
  DoCmd.Hourglass True
  Set db2 = CurrentDb
  db2.Execute ("DELETE TFlaechenbindungen.* FROM TFlaechenbindungen RIGHT JOIN TMitglieder ON TFlaechenbindungen.MGNR = TMitglieder.MGNR WHERE ZNR=" + Format(ZNR1) + ";")
  db2.Execute ("DELETE * FROM TMitglieder WHERE ZNR=" + Format(ZNR1) + ";")
  

 
 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 Set db2 = CurrentDb
 
 Set rs1 = db1.OpenRecordset(tempfilename1)
 Set rs2 = db2.OpenRecordset(filename1)

 While Not rs1.EOF
  ' Insert TMitglieder
  rs2.AddNew
  
  For item1 = 0 To db1.TableDefs(tempfilename1).Fields.Count - 1
   rs2(item1) = rs1(item1)
  Next item1
  rs2.Update
  rs1.MoveNext
 Wend
 
 DoCmd.Hourglass False
 MsgBox (Format(rs1.recordcount) + " Mitglieder importiert")
 DoCmd.Hourglass True
 
 rs1.Close
 rs2.Close
 db1.Close
 db2.Close


 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 Set db2 = CurrentDb
 
 Set rs1 = db1.OpenRecordset(tempfilename2)
 Set rs2 = db2.OpenRecordset(filename2)

 newFBNR = DMax("FBNR", "TFlaechenbindungen")
 While Not rs1.EOF
  ' Insert TFlaechenbindungen
  newFBNR = newFBNR + 1
  rs2.AddNew
  
  For item1 = 0 To db1.TableDefs(tempfilename2).Fields.Count - 1
   rs2(item1) = rs1(item1)
  Next item1
  rs2!FBNR = newFBNR
  rs2.Update
  rs1.MoveNext
 Wend
 DoCmd.Hourglass False
 MsgBox (Format(rs1.recordcount) + " Flächenbindungen importiert")
  
 rs1.Close
 rs2.Close
 db1.Close
 db2.Close

 End If
 
 
 
End Sub

Private Sub Form_Open(Cancel As Integer)

Dim filename

filename = GetParameter("ImportPfad")

If Len(filename) > 0 Then
 TImportFile = filename
End If

End Sub