Exported VBA
This commit is contained in:
310
wgmaster/vba/Form_MExport.frm
Normal file
310
wgmaster/vba/Form_MExport.frm
Normal file
@ -0,0 +1,310 @@
|
||||
|
||||
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
|
||||
Reference in New Issue
Block a user