Private Sub Babbrechen_Click()

DoCmd.Close

End Sub

Private Sub BOk_Click()

If OMitglieder = True Or OLieferungen = True Then

    If Not IsNull(TZNR) And TZNR <> "" Then

        DoCmd.Hourglass True
        ExportAll TExportFile, TZNR, TLesejahr
        DoCmd.Hourglass False
        
        SetParameter "ExportPfad", TExportFile
        DoCmd.Close
        
    Else
     MsgBox ("Bitte wählen Sie eine Zweigstelle aus !")
    End If

Else
 MsgBox ("Bitte wählen Sie zuerst aus, welche Daten Sie exportieren wollen !")
End If

End Sub



Sub ExportAll(filename As String, ZNR1 As Long, Lesejahr1 As Long)


Dim db1 As Database
Dim rs1 As Recordset
Dim db2 As Database
Dim rs2 As Recordset
Dim item1
Dim i As Integer
Dim tempfilename1 As String
Dim filename1 As String
Dim query1 As String
Dim datapath As String

datapath = GetDataPath


' Create new database
    

 If Fileexists(filename) Then FileSystem.Kill (filename)
  
 Set db2 = Application.DBEngine.Workspaces(0).CreateDatabase(filename, dbLangGeneral)
 db2.Close

 'TLieferungen
 
 If OLieferungen = True Then
      
     filename1 = "TLieferungen"
     tempfilename1 = "xTLieferungen"
     query1 = "SELECT * FROM TLieferungen WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1)
     
     Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
     Set db1 = CurrentDb
    
     DoCmd.TransferDatabase acImport, "Microsoft Access", datapath, acTable, filename1, tempfilename1, True
     DoCmd.TransferDatabase acExport, "Microsoft Access", filename, acTable, tempfilename1, tempfilename1, True
     DoCmd.DeleteObject acTable, tempfilename1
    
     Set rs2 = db2.OpenRecordset(tempfilename1)
     Set rs1 = db1.OpenRecordset(query1)
    
     While Not rs1.EOF
      rs2.AddNew
      For item1 = 0 To db2.TableDefs(tempfilename1).Fields.Count - 1
       rs2(item1) = rs1(item1)
      Next item1
      rs2.Update
      rs1.MoveNext
     Wend
     
     
     Dim lieferungen As Integer
     
     lieferungen = rs1.recordcount
     
     rs1.Close
     rs2.Close
     db1.Close
     db2.Close
     
     
    
    
     'TLieferungAbschlag
     filename1 = "TLieferungAbschlag"
     tempfilename1 = "xTLieferungAbschlag"
     query1 = "SELECT TLieferungAbschlag.* FROM TLieferungAbschlag INNER JOIN TLieferungen ON TLieferungAbschlag.LINR = TLieferungen.LINR WHERE ZNR=" + Format(ZNR1) + " AND Year(Datum)=" + Format(Lesejahr1)
     
     Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
     Set db1 = CurrentDb
    
     DoCmd.TransferDatabase acImport, "Microsoft Access", datapath, acTable, filename1, tempfilename1, True
     DoCmd.TransferDatabase acExport, "Microsoft Access", filename, acTable, tempfilename1, tempfilename1, True
     DoCmd.DeleteObject acTable, tempfilename1
    
     Set rs2 = db2.OpenRecordset(tempfilename1)
     Set rs1 = db1.OpenRecordset(query1)
    
     While Not rs1.EOF
      rs2.AddNew
      For item1 = 0 To db2.TableDefs(tempfilename1).Fields.Count - 1
       rs2(item1) = rs1(item1)
      Next item1
      rs2.Update
      rs1.MoveNext
     Wend
     'MsgBox (Format(rs1.RecordCount) + " Lieferungs-Abschläge exportiert")
     rs1.Close
     rs2.Close
     db1.Close
     db2.Close
     
    
     MsgBox (Format(lieferungen) + " Lieferungen exportiert")
     
 End If


 'TMitglieder
 
 If OMitglieder = True Then
 
     filename1 = "TMitglieder"
     tempfilename1 = "xTMitglieder"
     query1 = "SELECT * FROM TMitglieder WHERE ZNR=" + Format(ZNR1)
     
     Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
     Set db1 = CurrentDb
    
     DoCmd.TransferDatabase acImport, "Microsoft Access", datapath, acTable, filename1, tempfilename1, True
     DoCmd.TransferDatabase acExport, "Microsoft Access", filename, acTable, tempfilename1, tempfilename1, True
     DoCmd.DeleteObject acTable, tempfilename1
    
     Set rs2 = db2.OpenRecordset(tempfilename1)
     Set rs1 = db1.OpenRecordset(query1)
    
     While Not rs1.EOF
      rs2.AddNew
      For item1 = 0 To db2.TableDefs(tempfilename1).Fields.Count - 1
       rs2(item1) = rs1(item1)
      Next item1
      rs2.Update
      rs1.MoveNext
     Wend
     MsgBox (Format(rs1.recordcount) + " Mitglieder exportiert")
     rs1.Close
     rs2.Close
     db1.Close
     db2.Close
    
     'TFlaechenbindungen
     filename1 = "TFlaechenbindungen"
     tempfilename1 = "xTFlaechenbindungen"
     query1 = "SELECT TFlaechenbindungen.* FROM TMitglieder INNER JOIN TFlaechenbindungen ON TMitglieder.MGNR = TFlaechenbindungen.MGNR WHERE ZNR = " + Format(ZNR1)
     
     Set db2 = DBEngine.Workspaces(0).OpenDatabase(filename)
     Set db1 = CurrentDb
    
     DoCmd.TransferDatabase acImport, "Microsoft Access", datapath, acTable, filename1, tempfilename1, True
     DoCmd.TransferDatabase acExport, "Microsoft Access", filename, acTable, tempfilename1, tempfilename1, True
     DoCmd.DeleteObject acTable, tempfilename1
    
     Set rs2 = db2.OpenRecordset(tempfilename1)
     Set rs1 = db1.OpenRecordset(query1)
    
     While Not rs1.EOF
      rs2.AddNew
      For item1 = 0 To (db2.TableDefs(tempfilename1).Fields.Count - 1)
       rs2(item1) = rs1(item1)
      Next item1
      
      rs2.Update
      rs1.MoveNext
     Wend
     MsgBox (Format(rs1.recordcount) + " Flächenbindungen exportiert")
     rs1.Close
     rs2.Close
     db1.Close
     db2.Close
End If

'TChargen
If OChargen = True Then
      
     filename1 = "TChargen"
     tempfilename1 = "xTChargen"
     query1 = "SELECT * FROM TChargen WHERE ZNR=" + Format(ZNR1) + " AND Jahrgang=" + Format(Lesejahr1)
     
     Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
     Set db1 = CurrentDb
    
     DoCmd.TransferDatabase acImport, "Microsoft Access", datapath, acTable, filename1, tempfilename1, True
     DoCmd.TransferDatabase acExport, "Microsoft Access", filename, acTable, tempfilename1, tempfilename1, True
     DoCmd.DeleteObject acTable, tempfilename1
    
     Set rs2 = db2.OpenRecordset(tempfilename1)
     Set rs1 = db1.OpenRecordset(query1)
    
     While Not rs1.EOF
      rs2.AddNew
      For item1 = 0 To db2.TableDefs(tempfilename1).Fields.Count - 1
       rs2(item1) = rs1(item1)
      Next item1
      rs2.Update
      rs1.MoveNext
     Wend
     
     MsgBox (Format(rs1.recordcount) + " Chargen exportiert")
     
     rs1.Close
     rs2.Close
     db1.Close
     db2.Close

 End If





Exit Sub

WhatIsLos:
 MsgBox ("Error")


End Sub






Private Sub Form_Open(Cancel As Integer)

TZNR = DFirst("ZNR", "TZweigstellen")
If Month(Date) < 9 Then
 TLesejahr = year(Date) - 1
Else
 TLesejahr = year(Date)
End If
OListe = 1

Dim filename

filename = GetParameter("ExportPfad")

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


End Sub


Private Sub OChargen_Click()

If OLieferungen = True Or OChargen = True Then
 TLesejahr.Visible = True
 XLesejahr.Visible = True
Else
 TLesejahr.Visible = False
 XLesejahr.Visible = False
End If

End Sub

Private Sub OLieferungen_Click()

If OLieferungen = True Or OChargen = True Then
 TLesejahr.Visible = True
 XLesejahr.Visible = True
Else
 TLesejahr.Visible = False
 XLesejahr.Visible = False
End If

End Sub

Function Fileexists(filename As String) As Boolean

On Error GoTo NoFile

If FileSystem.GetAttr(filename) >= 0 Then
 Fileexists = True
Else
 Fileexists = False
End If

Exit Function

NoFile:
 Fileexists = False
 Exit Function

End Function