659 lines
13 KiB
Plaintext
659 lines
13 KiB
Plaintext
|
|
|
|
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 |