310 lines
7.3 KiB
Plaintext
310 lines
7.3 KiB
Plaintext
|
|
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 |