645 lines
26 KiB
VB.net
645 lines
26 KiB
VB.net
Imports System.DirectoryServices.ActiveDirectory
|
|
Imports com.sun.tools.corba.se.idl.constExpr
|
|
Imports VERAG_PROG_ALLGEMEIN
|
|
|
|
Public Class frmGoMautBoxen_Bestellung
|
|
Public kundenNr = -1
|
|
|
|
Dim kunde As cKunde
|
|
Dim adresse As cAdressen
|
|
Dim kundeErw As cKundenErweitert
|
|
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
|
|
|
|
Dim dt As New DataTable
|
|
|
|
Public addnew = False
|
|
Public WithEvents s As New cBinding("SDL") 'fürs Binding
|
|
Dim changed As Boolean = False
|
|
Dim ready As Boolean = False
|
|
|
|
Sub New(kundenNr)
|
|
|
|
' Dieser Aufruf ist für den Designer erforderlich.
|
|
InitializeComponent()
|
|
|
|
Me.kundenNr = kundenNr
|
|
Me.addnew = addnew
|
|
|
|
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
|
|
|
|
End Sub
|
|
|
|
Sub New(kunde As cKunde, adresse As cAdressen, kundeErw As cKundenErweitert)
|
|
|
|
' Dieser Aufruf ist für den Designer erforderlich.
|
|
InitializeComponent()
|
|
|
|
Me.kunde = kunde
|
|
Me.adresse = adresse
|
|
Me.kundeErw = kundeErw
|
|
|
|
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
|
|
|
|
End Sub
|
|
|
|
Private Sub btnOK_Click(sender As Object, e As EventArgs) Handles btnOK.Click
|
|
|
|
lblWarning.Text = ""
|
|
|
|
If kunde Is Nothing And kundenNr < 0 Then
|
|
lblWarning.Text = "Bitte Kunden-Nr eingeben."
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
If cbxKK.SelectedValue = "" Then
|
|
lblWarning.Text = "Bitte Kreditkarten-Nr eingeben."
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
btnOK.DialogResult = DialogResult.OK
|
|
|
|
'txtKennzeichen.Text = txtKennzeichen.Text.ToUpper.Trim
|
|
'txtNationalitaet.Text = txtNationalitaet.Text.ToUpper
|
|
'Label5.ForeColor = Color.Black
|
|
'lblErfassung.ForeColor = Color.Black
|
|
'If KdSearchBox1.KdNr < 0 Then Label5.ForeColor = Color.Red : Me.DialogResult = Windows.Forms.DialogResult.None : Exit Sub
|
|
'If txtKennzeichen.Text = "" Then lblErfassung.ForeColor = Color.Red : Me.DialogResult = Windows.Forms.DialogResult.None : Exit Sub
|
|
|
|
'If s.updateBinding Then
|
|
' Dim SQL As New SQL
|
|
' If oldkfz <> txtKennzeichen.Text Then
|
|
' VERAG_PROG_ALLGEMEIN.DATENVERVER_OPTIONS.REMANE_FOLDER_KDNR(New VERAG_PROG_ALLGEMEIN.cDatenserver_Change_Value("DOKUMENTE", "MDM", kundenNr, oldkfz, Nothing, Nothing),
|
|
' New VERAG_PROG_ALLGEMEIN.cDatenserver_Change_Value("DOKUMENTE", "MDM", kundenNr, txtKennzeichen.Text, Nothing, Nothing))
|
|
' SQL.doSQL("UPDATE SDL SET KfzKennzeichen= '" & txtKennzeichen.Text & "' WHERE KundenNr='" & kundenNr & "' AND KfzKennzeichen='" & oldkfz & "'", "SDL", True)
|
|
' SQL.doSQL("UPDATE [Kartenpool] SET KfzKennzeichen= '" & txtKennzeichen.Text & "' WHERE KundenNr='" & kundenNr & "' AND KfzKennzeichen='" & oldkfz & "'", "SDL", True)
|
|
' End If
|
|
' Me.Close()
|
|
'End If
|
|
End Sub
|
|
|
|
|
|
Sub initdgv()
|
|
Try
|
|
|
|
Dim setKdNr
|
|
If kundenNr > 0 Then
|
|
setKdNr = kundenNr
|
|
ElseIf kunde IsNot Nothing Then
|
|
setKdNr = kunde.KundenNr
|
|
Else
|
|
setKdNr = -1
|
|
|
|
End If
|
|
|
|
dt = SQL.loadDgvBySql("SELECT Kreditkarten.KartenNr, Kreditkarten.Kartenablaufmonat, Kreditkarten.Kartenablaufjahr FROM Kreditkarten WHERE (((Kreditkarten.AdressenNr)=" & setKdNr & ") AND ((Kreditkarten.NeueKartenNr) Is Null)) ORDER BY Kreditkarten.KartenNr", "FMZOLL")
|
|
|
|
If dt.Rows.Count > 0 Then
|
|
Dim dv As New DataView(dt, "KartenNr<>''", "KartenNr", DataViewRowState.CurrentRows)
|
|
Dim dt_new As DataTable = dv.ToTable(False, "KartenNr")
|
|
cbxKK.DataSource = dv
|
|
cbxKK.DisplayMember = "KartenNr"
|
|
cbxKK.ValueMember = "KartenNr"
|
|
cbxKK.changeItem(dv.Item(0).Row.Item(0))
|
|
End If
|
|
|
|
|
|
Catch ex As Exception
|
|
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
|
|
End Try
|
|
|
|
|
|
If addnew Then newEntry() 'NEUER EINTRAG!
|
|
ready = True
|
|
End Sub
|
|
|
|
Public Sub newEntry()
|
|
' s.updateBinding()
|
|
Dim row = s.bindingdataTable.NewRow()
|
|
row.Item("KundenNr") = kundenNr
|
|
row.Item("KfzKennzeichen") = ""
|
|
s.bindingdataTable.Rows.Add(row)
|
|
|
|
s.bindingSource.MoveLast()
|
|
'If save Then updateBinding()
|
|
lblAenderung.Text = Now.ToString("dd.MM.yyyy HH:mm")
|
|
lblSachbearb.Text = VERAG_PROG_ALLGEMEIN.cAllgemein.USRKURZNAME
|
|
If kundenNr < 0 Then KdSearchBox1.Enabled = True
|
|
End Sub
|
|
|
|
Sub BindingTableColumnChanged(sender As Object, e As System.Data.DataColumnChangeEventArgs)
|
|
If ready Then
|
|
lblSachbearb.Text = VERAG_PROG_ALLGEMEIN.cAllgemein.USRKURZNAME
|
|
lblAenderung.Text = Now.ToString("dd.MM.yyyy HH:mm")
|
|
changed = True
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Private Sub btnAbbrechen_Click(sender As Object, e As EventArgs) Handles btnAbbrechen.Click ', Me.FormClosing
|
|
If changed Then
|
|
Select Case MsgBox("Änderungen speichern", vbYesNoCancel)
|
|
Case vbYes : Me.DialogResult = Windows.Forms.DialogResult.None : btnOK.PerformClick()
|
|
Case vbNo : Me.Close()
|
|
Case vbCancel : Me.DialogResult = Windows.Forms.DialogResult.None
|
|
End Select
|
|
Else
|
|
Me.Close()
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub frmLKWDetails_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
|
|
If e.KeyCode = Keys.Return Then
|
|
btnOK.PerformClick()
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub frmLKWDetails_Load(sender As Object, e As EventArgs) Handles Me.Load
|
|
|
|
'If Not VERAG_PROG_ALLGEMEIN.cBerechtignunen.CHECK_BERECHTIGUNG_bool("MAUTBOXEN_bearbeiten", Me) Then
|
|
' MsgBox("Keine Berechtigung!")
|
|
' Me.Close()
|
|
'End If
|
|
|
|
KdSearchBox1.initKdBox(Me)
|
|
|
|
|
|
If kundenNr > 0 Then
|
|
Me.KdSearchBox1.KdNr = kundenNr
|
|
KdSearchBox1.Enabled = False
|
|
End If
|
|
|
|
cbxLandKz.fillWithSQL(" select distinct landkz, Währungstabelle.Land from Währungstabelle where landkz is not null order by LandKz", , "FMZOLL", True)
|
|
|
|
initKunde()
|
|
|
|
End Sub
|
|
|
|
Private Sub KdSearchBox1_PropertyChanged(sender As Object, e As System.ComponentModel.PropertyChangedEventArgs) Handles KdSearchBox1.PropertyChanged
|
|
initKunde()
|
|
End Sub
|
|
|
|
|
|
Private Sub initKunde()
|
|
|
|
If kundenNr < 0 Then
|
|
|
|
|
|
If adresse IsNot Nothing Then
|
|
|
|
txtName.Text = If(adresse.Name_1, "") & If(adresse.Name_2, "")
|
|
txtStrasse.Text = If(adresse.Straße, "")
|
|
txtOrt.Text = If(adresse.Ort, "")
|
|
txtPlz.Text = If(adresse.PLZ, "")
|
|
cbxLandKz.changeItem(If(adresse.LandKz, ""))
|
|
txtAnsprechpartnerAnrede.Text = adresse.Anrede
|
|
txtAnsprechpartner.Text = adresse.Ansprechpartner
|
|
txtFax.Text = adresse.Telefax
|
|
txtEmail.Text = adresse.E_Mail
|
|
|
|
initdgv()
|
|
|
|
End If
|
|
|
|
Else
|
|
|
|
|
|
If KdSearchBox1.KdNr_value > 0 AndAlso KdSearchBox1.KdData_ADRESSEN IsNot Nothing AndAlso KdSearchBox1.KdData_KUNDE IsNot Nothing Then
|
|
|
|
Dim AD = KdSearchBox1.KdData_ADRESSEN
|
|
Dim KD = KdSearchBox1.KdData_KUNDE
|
|
Dim KDERW = KdSearchBox1.KdData_KUNDE_ERW
|
|
|
|
txtName.Text = If(AD.Name_1, "") & If(AD.Name_2, "")
|
|
txtStrasse.Text = If(AD.Straße, "")
|
|
txtOrt.Text = If(AD.Ort, "")
|
|
txtPlz.Text = If(AD.PLZ, "")
|
|
cbxLandKz.changeItem(If(AD.LandKz, ""))
|
|
txtAnsprechpartnerAnrede.Text = AD.Anrede
|
|
txtAnsprechpartner.Text = AD.Ansprechpartner
|
|
|
|
initdgv()
|
|
|
|
End If
|
|
End If
|
|
|
|
|
|
End Sub
|
|
|
|
Private Sub cbxKK_SelectedValueChanged(sender As Object, e As EventArgs)
|
|
|
|
If cbxKK.SelectedValue Is Nothing OrElse cbxKK.SelectedValue.ToString = "System.Data.DataRowView" Then
|
|
txtMonat.Text = ""
|
|
txtJahr.Text = ""
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim dr() As DataRow = dt.Select("KartenNr = " & cbxKK.SelectedValue)
|
|
|
|
txtMonat.Text = dr(0).Item(1)
|
|
txtJahr.Text = dr(0).Item(2)
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
' Select Case tbl_GO_BOX_Bestellung.*
|
|
'From tbl_GO_BOX_Bestellung
|
|
'Where (((tbl_GO_BOX_Bestellung.Bestelldatum) Is Null) And ((tbl_GO_BOX_Bestellung.Bestellnummer) Is Null))
|
|
'Order By tbl_GO_BOX_Bestellung.ID;
|
|
|
|
|
|
|
|
' Private Sub AdressenNr_AfterUpdate()
|
|
|
|
' Dim rst1 As DAO.Recordset
|
|
' Dim rst2 As DAO.Recordset
|
|
' Dim strSQL As String
|
|
' Dim strCardNum As String
|
|
' Dim intZlr As Integer
|
|
|
|
'100 If Not IsNull(Me!AdressenNr) Then
|
|
' ' Mit AdressenNr in FMZoll Adressbestand lesen.
|
|
'110 strSQL = "SELECT Adressen.[Name 1], Adressen.[Name 2], Adressen.Straße, Adressen.LandKz, Adressen.PLZ, Adressen.Ort, Adressen.Telefon, Adressen.Telefax" & _
|
|
' " FROM Adressen" & _
|
|
' " WHERE (((Adressen.AdressenNr)=" & Me![AdressenNr] & "));"
|
|
'120 Set rst1 = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
|
|
'130 With rst1
|
|
'140 If Not .EOF Then
|
|
' ' Firmendaten aus FMZoll übernehmen.
|
|
'150 Me!Company1 = Nz(![Name 1], "-")
|
|
'160 Me!Company2 = ![Name 2]
|
|
'170 Me!CompanyStreet = Nz(!Straße, "-")
|
|
'180 Me!CompanyNumber = "-"
|
|
'190 Me!CompanyCode = Nz(!PLZ, "-")
|
|
'200 Me!CompanyCity = Nz(!Ort, "-")
|
|
'210 Me!CompanyTelephone = !Telefon
|
|
'220 Me!CompanyTelefax = !Telefax
|
|
'230 If Not IsNull(!Straße) Then
|
|
' ' Straße und Hausnummer aufteilen.
|
|
'240 For intZlr = 1 To Len(!Straße)
|
|
'250 If Mid(!Straße, intZlr, 1) Like "[0-9]" Then
|
|
'260 Me!CompanyStreet = IIf(Len(Trim(Left(!Straße, intZlr - 1))) = 0, "-", Trim(Left(!Straße, intZlr - 1)))
|
|
'270 Me!CompanyNumber = Trim(Mid(!Straße, intZlr, 10))
|
|
'280 Exit For
|
|
'290 End If
|
|
'300 Next intZlr
|
|
'310 End If
|
|
'320 If Not IsNull(!LandKz) Then
|
|
' ' Land und Länderkürzel aus LandKz ableiten.
|
|
'330 strSQL = "SELECT tbl_GO_BOX_Länderliste.Land, tbl_GO_BOX_Länderliste.Länderkürzel" & _
|
|
' " FROM tbl_GO_BOX_Länderliste" & _
|
|
' " WHERE (((tbl_GO_BOX_Länderliste.LandKz)='" & ![LandKz] & "'))" & _
|
|
' " OR (((tbl_GO_BOX_Länderliste.Länderkürzel)='" & ![LandKz] & "'));"
|
|
'340 Set rst2 = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
|
|
'350 If Not rst2.EOF Then
|
|
'360 Me!CompanyCountry = rst2!Land
|
|
'370 Me!CompanyCountryAbbr = rst2!Länderkürzel
|
|
'380 Me![License plate Nationality] = rst2!Länderkürzel
|
|
'390 End If
|
|
'400 rst2.Close
|
|
'410 End If
|
|
' ' Kartennummer mit Prüfziffer ermitteln.
|
|
'420 strCardNum = "990001" & Format(Right(Me!AdressenNr, 6), "000000") & "0001"
|
|
'430 Me!CardNum = strCardNum & (fktMod10(strCardNum))
|
|
'440 End If
|
|
'450 .Close
|
|
'460 End With
|
|
'470 End If
|
|
|
|
' End Sub
|
|
|
|
' Private Sub CardNum_BeforeUpdate(Cancel As Integer)
|
|
|
|
'480 If Not IsNull(Me!CardNum) Then
|
|
' ' CardNumber prüfen.
|
|
'490 If (Right(Me!CardNum, 1)) <> (fktMod10(Left(Me!CardNum, Len(Me!CardNum) - 1))) Then
|
|
'500 MsgBox "CardNum ungültig. Prüfziffernfehler!", vbCritical, "Eingabeprüfung"
|
|
'510 Cancel = True
|
|
'520 End If
|
|
'530 End If
|
|
|
|
' End Sub
|
|
|
|
' Private Sub Form_Open(Cancel As Integer)
|
|
'540 Cancel = BerechtigungsprüfungForm(Me)
|
|
'550 If Cancel Then Exit Sub
|
|
' End Sub
|
|
|
|
' Private Sub License_plate_AfterUpdate()
|
|
'560 Me![License plate] = UCase(Me![License plate])
|
|
' End Sub
|
|
|
|
' Private Sub License_plate_BeforeUpdate(Cancel As Integer)
|
|
|
|
' Dim intI As Integer
|
|
|
|
'570 If Not IsNull(Me![License plate]) Then
|
|
'580 For intI = 1 To Len(Me![License plate])
|
|
'590 Select Case Mid(Me![License plate], intI, 1)
|
|
' Case "0" To "9", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", " ", "-"
|
|
' ' gültige Zeichen
|
|
'600 Case Else
|
|
'610 MsgBox "Ungültiges Zeichen: " & Mid(Me![License plate], intI, 1), vbInformation, "Eingabeprüfung"
|
|
'620 Cancel = True
|
|
'630 End Select
|
|
'640 Next intI
|
|
'650 End If
|
|
|
|
' End Sub
|
|
|
|
|
|
|
|
'-------------------------------------------------------BESTELLVORGANG
|
|
|
|
' Option Compare Database
|
|
'Option Explicit On
|
|
|
|
' Private Const olFolderInbox = 6
|
|
' Private Const olMailItem = 0
|
|
|
|
' Private Sub Bestellliste_DblClick(Cancel As Integer)
|
|
'100 Me!Bestelldatum = Me!Bestellliste.Column(1)
|
|
'110 Me!Bestellnummer = Me!Bestellliste.Column(2)
|
|
'120 Me!Bestellanzahl = Me!Bestellliste.Column(3)
|
|
' End Sub
|
|
|
|
' Private Sub cmdBestelldateiErzeugen_Click()
|
|
|
|
' Dim fso As FileSystemObject
|
|
' Dim wrk As DAO.Workspace
|
|
' Dim db As DAO.Database
|
|
' Dim qry As DAO.QueryDef
|
|
' Dim rst1 As DAO.Recordset
|
|
' Dim rst2 As DAO.Recordset
|
|
' Dim rst3 As DAO.Recordset
|
|
' Dim dateBestelldatum As Date
|
|
' Dim intBestellnummer As Integer
|
|
' Dim lngBestellanzahl As Long
|
|
' Dim lngFortschritt As Long
|
|
' Dim strVerzeichnispfad As String
|
|
' Dim strDateiname As String
|
|
' Dim strPrompt As String
|
|
' Dim strTitle As String
|
|
' Dim boolHTrans As Boolean
|
|
|
|
'130 On Error GoTo PROC_Error
|
|
|
|
'140 dateBestelldatum = Date
|
|
|
|
' ' Arbeitsbereich zuweisen.
|
|
'150 Set wrk = DBEngine.Workspaces(0)
|
|
' ' Datenbank zuweisen.
|
|
'160 Set db = CurrentDb()
|
|
' ' FileSystemObject zuweisen.
|
|
'170 Set fso = New FileSystemObject
|
|
|
|
' ' Wenn der Verzeichnispfad nicht existiert, diesen anlegen.
|
|
'180 strVerzeichnispfad = DLookup("[Verzeichnispfad]", "tblPfad", "[ID] = 4")
|
|
'190 If Not fso.FolderExists(strVerzeichnispfad) Then
|
|
'200 fso.CreateFolder (strVerzeichnispfad)
|
|
'210 End If
|
|
|
|
' ' Kreditkarten in die Tabelle eintragen.
|
|
'220 Call SysCmd(acSysCmdSetStatus, "Kreditkarten für Bestellungen eintragen.")
|
|
'230 Set rst1 = db.OpenRecordset("qry_GO_BOX_BestellnummerEintragen", dbOpenSnapshot)
|
|
'240 With rst1
|
|
'250 Do Until .EOF
|
|
'260 If Not IsNull(!AdressenNr) And Not IsNull(!CardNum) Then
|
|
'270 Set qry = db.QueryDefs("qry_GO_BOX_KreditkartenVerwalten")
|
|
'280 qry.Parameters("[Bitte AdressenNr eingeben]") = !AdressenNr
|
|
'290 qry.Parameters("[Bitte KartenNr eingeben]") = !CardNum
|
|
'300 Set rst3 = qry.OpenRecordset(dbOpenDynaset)
|
|
'310 If rst3.EOF Then
|
|
'320 rst3.AddNew
|
|
'330 rst3!AdressenNr = !AdressenNr
|
|
'340 rst3!KartenNr = !CardNum
|
|
'350 rst3!Kartenfreischaltungsdatum = Date
|
|
'360 rst3!Kartenablaufmonat = !CardValidMonth
|
|
'370 rst3!Kartenablaufjahr = !CardValidYear
|
|
'380 rst3!Kartensperre = 0
|
|
'390 rst3!Zeitstempel = Now
|
|
'400 rst3!Sachbearbeiter = UCase(CurrentUser())
|
|
'410 rst3.Update
|
|
'420 End If
|
|
'430 rst3.Close
|
|
'440 Set rst3 = Nothing
|
|
'450 qry.Close
|
|
'460 Set qry = Nothing
|
|
'470 End If
|
|
'480 .MoveNext
|
|
'490 Loop
|
|
'500 .Close
|
|
'510 End With
|
|
'520 Set rst1 = Nothing
|
|
'530 Call SysCmd(acSysCmdClearStatus)
|
|
|
|
' ' Haupttransaktion starten.
|
|
'540 wrk.BeginTrans
|
|
'550 boolHTrans = True
|
|
'560 Call SysCmd(acSysCmdSetStatus, "Bestellungen lesen.")
|
|
'570 Set rst1 = db.OpenRecordset("qry_GO_BOX_BestellnummerEintragen", dbOpenDynaset, dbDenyWrite)
|
|
'580 With rst1
|
|
'590 If .EOF Then 'Abfrage liefert keine Datensätze
|
|
'600 .Close
|
|
' ' Haupttransaktion beenden.
|
|
'610 wrk.CommitTrans
|
|
'620 boolHTrans = False
|
|
' ' Meldung anzeigen.
|
|
'630 strPrompt = "Keine Bestelldaten vorhanden."
|
|
'640 strTitle = "Bestelldatei erzeugen"
|
|
'650 MsgBox strPrompt, vbInformation, strTitle
|
|
'660 Else
|
|
'670 DoCmd.Hourglass True
|
|
'680 Set rst2 = db.OpenRecordset("qry_GO_BOX_BestellnummerVerwalten", dbOpenDynaset)
|
|
'690 If rst2.EOF Then
|
|
'700 intBestellnummer = 1
|
|
'710 Else
|
|
'720 If rst2!Bestellnummer = 9999 Then
|
|
'730 intBestellnummer = 1
|
|
'740 Else
|
|
'750 intBestellnummer = rst2!Bestellnummer + 1
|
|
'760 End If
|
|
'770 End If
|
|
'780 .MoveLast
|
|
'790 lngBestellanzahl = .RecordCount
|
|
'800 Call SysCmd(acSysCmdInitMeter, "Bestellnummer eintragen.", .RecordCount)
|
|
'810 .MoveFirst
|
|
'820 lngFortschritt = 0
|
|
'830 Do Until .EOF
|
|
'840 lngFortschritt = lngFortschritt + 1
|
|
'850 Call SysCmd(acSysCmdUpdateMeter, lngFortschritt)
|
|
' ' Bestellinformationen eintragen.
|
|
'860 .Edit
|
|
'870 !Bestelldatum = dateBestelldatum
|
|
'880 !Bestellnummer = intBestellnummer
|
|
'890 .Update
|
|
'900 Call fktSDL_GO_BOX_Bestellvorgang(rst1)
|
|
'910 .MoveNext
|
|
'920 Loop
|
|
' ' Bestellnummern verwalten.
|
|
'930 rst2.AddNew
|
|
'940 rst2!Bestelldatum = dateBestelldatum
|
|
'950 rst2!Bestellnummer = intBestellnummer
|
|
'960 rst2!Bestellanzahl = lngBestellanzahl
|
|
'970 rst2.Update
|
|
'980 rst2.Close
|
|
'990 Set rst2 = Nothing
|
|
'1000 .Close
|
|
' ' Haupttransaktion beenden.
|
|
'1010 wrk.CommitTrans dbForceOSFlush
|
|
'1020 boolHTrans = False
|
|
' ' Bestellinformationen im Formular eintragen.
|
|
'1030 Me!Bestelldatum = dateBestelldatum
|
|
'1040 Me!Bestellnummer = intBestellnummer
|
|
'1050 Me!Bestellanzahl = lngBestellanzahl
|
|
' ' Bestelldatei erzeugen.
|
|
'1060 strDateiname = fso.BuildPath(strVerzeichnispfad, "PO_VG_" & Format(intBestellnummer, "0000") & "_" & Format(dateBestelldatum, "ddmmyy") & ".csv")
|
|
'1070 DoCmd.TransferText acExportDelim, "GO_BOX_Bestellung", "qry_GO_BOX_Bestellung", strDateiname
|
|
' ' Neue Bestellung in die Bestellliste aufnehmen.
|
|
'1080 Me!Bestellliste.Requery
|
|
'1090 End If
|
|
'1100 End With
|
|
'1110 Set rst1 = Nothing
|
|
|
|
'PROC_Exit:
|
|
'1120 On Error Resume Next
|
|
'1130 If Not rst3 Is Nothing Then
|
|
'1140 rst3.Close
|
|
'1150 Set rst3 = Nothing
|
|
'1160 End If
|
|
'1170 If Not rst2 Is Nothing Then
|
|
'1180 rst2.Close
|
|
'1190 Set rst2 = Nothing
|
|
'1200 End If
|
|
'1210 If Not rst1 Is Nothing Then
|
|
'1220 rst1.Close
|
|
'1230 Set rst1 = Nothing
|
|
'1240 End If
|
|
'1250 If Not qry Is Nothing Then
|
|
'1260 qry.Close
|
|
'1270 Set qry = Nothing
|
|
'1280 End If
|
|
'1290 If Not fso Is Nothing Then Set fso = Nothing
|
|
'1300 If Not db Is Nothing Then Set db = Nothing
|
|
'1310 If Not wrk Is Nothing Then Set wrk = Nothing
|
|
'1320 Call SysCmd(acSysCmdClearStatus)
|
|
'1330 DoCmd.Hourglass False
|
|
'1340 Exit Sub
|
|
|
|
'PROC_Error:
|
|
'1350 If boolHTrans Then
|
|
'1360 Call SysCmd(acSysCmdSetStatus, "Änderungen an den Daten werden zurückgenommen...")
|
|
'1370 wrk.Rollback
|
|
'1380 boolHTrans = False
|
|
'1390 End If
|
|
'1400 DoCmd.Hourglass False
|
|
'1410 ErrNotify Err, "Form_frm_GO_BOX_Bestellvorgang", "cmdBestelldateiErzeugen_Click", eNormalError
|
|
'1420 Resume PROC_Exit
|
|
|
|
' End Sub
|
|
|
|
' Private Sub cmdBestelldateiSenden_Click()
|
|
|
|
' Dim appOutlook As Object
|
|
' Dim objNameSpace As Object
|
|
' Dim objFolder As Object
|
|
' Dim objMail As Object
|
|
' Dim strVerzeichnispfad As String
|
|
' Dim strDateiname As String
|
|
' Dim strPrompt As String
|
|
' Dim strTitle As String
|
|
|
|
'1430 On Error GoTo PROC_Error
|
|
|
|
'1440 If IsNull(Me!Bestelldatum) Then
|
|
'1450 DoCmd.Beep
|
|
'1460 strPrompt = "Bestelldatum?" & _
|
|
' " Sie müssen erst eine Bestelldatei erzeugen, oder eine Vorhandene durch Doppelklick auswählen."
|
|
'1470 strTitle = "Eingabeprüfung"
|
|
'1480 MsgBox strPrompt, vbInformation, strTitle
|
|
'1490 Exit Sub
|
|
'1500 End If
|
|
|
|
'1510 If IsNull(Me!Bestellnummer) Then
|
|
'1520 DoCmd.Beep
|
|
'1530 strPrompt = "Bestellnummer?" & _
|
|
' " Sie müssen erst eine Bestelldatei erzeugen, oder eine Vorhandene durch Doppelklick auswählen."
|
|
'1540 strTitle = "Eingabeprüfung"
|
|
'1550 MsgBox strPrompt, vbInformation, strTitle
|
|
'1560 Exit Sub
|
|
'1570 End If
|
|
|
|
' ' Mailversand über OLE-Automation
|
|
' ' Programmierung S. 786 (13.11.2)
|
|
|
|
' ' Prüfen, ob die Bestelldatei vorhanden ist.
|
|
'1580 strVerzeichnispfad = DLookup("[Verzeichnispfad]", "tblPfad", "[ID] = 4")
|
|
'1590 strDateiname = Dir(strVerzeichnispfad & "PO_VG_" & Format(Forms!frm_GO_BOX_Bestellvorgang!Bestellnummer, "0000") & "_" & Format(Forms!frm_GO_BOX_Bestellvorgang!Bestelldatum, "ddmmyy") & ".csv")
|
|
'1600 If strDateiname = "" Then
|
|
'1610 strPrompt = "Die Bestelldatei existiert nicht."
|
|
'1620 strTitle = "Bestelldatei senden"
|
|
'1630 MsgBox strPrompt, vbInformation, strTitle
|
|
'1640 Else
|
|
'1650 On Error Resume Next
|
|
'1660 Set appOutlook = GetObject(, "Outlook.Application")
|
|
'1670 If Err.Number <> 0 Then
|
|
'1680 If Err.Number = 429 Then ' Outlook wurde noch nicht gestartet.
|
|
'1690 Err.Clear
|
|
'1700 On Error GoTo PROC_Error
|
|
' ' Outlook starten.
|
|
'1710 Set appOutlook = CreateObject("Outlook.Application")
|
|
'1720 Set objNameSpace = appOutlook.GetNamespace("MAPI")
|
|
'1730 Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
|
|
' ' Posteingang anzeigen.
|
|
'1740 objFolder.Display
|
|
'1750 Else
|
|
'1760 GoTo PROC_Error
|
|
'1770 End If
|
|
'1780 End If
|
|
'1790 On Error GoTo PROC_Error
|
|
'1800 Set objMail = appOutlook.CreateItem(olMailItem)
|
|
'1810 With objMail
|
|
'1820 .To = Forms!frm_GO_BOX_Bestellvorgang!EMailAdresse
|
|
'1830 .Subject = "GO-BOX Bestellung Nr. " & Forms!frm_GO_BOX_Bestellvorgang!Bestellnummer & " vom " & Forms!frm_GO_BOX_Bestellvorgang!Bestelldatum
|
|
'1840 .Body = "Als Anhang senden wir Ihnen die Datei """ & strDateiname & """ mit den GO-BOX-Bestellungen." & _
|
|
' vbCrLf & vbCrLf & "Mit freundlichen Grüssen" & _
|
|
' vbCrLf & "VERAG Spedition AG" & _
|
|
' vbCrLf & "ASFINAG-Mautabteilung" & _
|
|
' vbCrLf & "______________________" & _
|
|
' vbCrLf & "Tel. +43 7711 2777 - 14 o. 17 o. 47" & _
|
|
' vbCrLf & "Fax +43 7711 3386" & _
|
|
' vbCrLf & "email: maut.asfinag@verag.ag" & _
|
|
' vbCrLf & "www.verag.ag"
|
|
'1850 .Attachments.Add (strVerzeichnispfad & "PO_VG_" & Format(Forms!frm_GO_BOX_Bestellvorgang!Bestellnummer, "0000") & "_" & Format(Forms!frm_GO_BOX_Bestellvorgang!Bestelldatum, "ddmmyy") & ".csv")
|
|
' ' Mail mit "Display" anzeigen und dann durch anklicken von Senden verschicken.
|
|
' '.Display
|
|
' ' oder alternativ Senden programmgesteuert durchführen.
|
|
'1860 .send
|
|
'1870 End With
|
|
'1880 Set objMail = Nothing
|
|
'1890 Set objFolder = Nothing
|
|
'1900 Set objNameSpace = Nothing
|
|
'1910 Set appOutlook = Nothing
|
|
'1920 strPrompt = "Die Bestelldatei wurde gesendet." & vbCrLf & strDateiname
|
|
'1930 strTitle = "Bestelldatei senden"
|
|
'1940 MsgBox strPrompt, vbInformation, strTitle
|
|
'1950 End If
|
|
|
|
'PROC_Exit:
|
|
'1960 On Error Resume Next
|
|
'1970 Exit Sub
|
|
|
|
'PROC_Error:
|
|
'1980 ErrNotify Err, "Form_frm_GO_BOX_Bestellvorgang", "cmdBestelldateiSenden_Click", eNormalError
|
|
'1990 Resume PROC_Exit
|
|
|
|
' End Sub
|
|
|
|
' Private Sub Form_Open(Cancel As Integer)
|
|
'2000 Cancel = BerechtigungsprüfungForm(Me)
|
|
'2010 If Cancel Then Exit Sub
|
|
' End Sub
|
|
End Class |