Move wgmaster/vba/Form_* to wgmaster/vba/form/*
This commit is contained in:
659
wgmaster/vba/form/Form_MImport.frm
Normal file
659
wgmaster/vba/form/Form_MImport.frm
Normal file
@ -0,0 +1,659 @@
|
||||
|
||||
|
||||
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
|
||||
Reference in New Issue
Block a user