884 lines
37 KiB
VB.net
884 lines
37 KiB
VB.net
|
|
Imports javax.xml.bind.annotation
|
|
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
|
|
Dim changed As Boolean = False
|
|
Dim ready As Boolean = False
|
|
Dim Land2ISOcode As String = ""
|
|
|
|
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 btnNew.Click
|
|
|
|
lblWarning.Text = ""
|
|
|
|
If Not checkValues() Then
|
|
btnNew.DialogResult = DialogResult.None
|
|
Exit Sub
|
|
Else
|
|
btnNew.DialogResult = DialogResult.OK
|
|
End If
|
|
|
|
Dim cardNum As String = cbxKK.SelectedValue
|
|
|
|
txtLicensePlate.Text = txtLicensePlate.Text.ToUpper.Trim
|
|
Dim LicenseNat As String = getLand(MyComboBox3._value)
|
|
|
|
'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
|
|
|
|
Dim LandBez As String = cbxLandKz.SelectedItem.ToString
|
|
|
|
If LandBez <> "" Then
|
|
LandBez = LandBez.Replace(cbxLandKz._value, "")
|
|
LandBez = LandBez.Replace("-", "")
|
|
LandBez = LandBez.Trim()
|
|
End If
|
|
|
|
If Not SQL.doSQL("INSERT INTO VERAG.dbo.tblGOBOXBestellungen (gb_adressNr,gb_transactionTyp,gb_company1,gb_company2,gb_companyStreet,gb_companyStreetNr,gb_companyPostalcode,gb_companyCity,gb_companyCountryISO,gb_companyCountry,gb_companyTel,gb_companyFax,gb_salutation,gb_title,gb_firstname,gb_lastname,gb_email,gb_personLanguage,gb_licensePlate,gb_licensePlateNat,gb_vehicleTyp,gb_Axles,gb_CardNum,gb_CardValidMonth,gb_CardValidYear)
|
|
VALUES (" & kunde.KundenNr & ",'" & MyComboBox1._value & "','" & txtName.Text & "','" & txtName2.Text & "','" & txtStrasse.Text & "','" & txtStasseNr.Text & "','" & txtPlz.Text & "','" & txtOrt.Text & "','" & getLand(cbxLandKz._value) & "','" & LandBez & "','" & txtTel.Text & "','" & txtFax.Text & "','" & txtAnsprechpartnerAnrede.Text & "','" & txtTitle.Text & "','" & txtAnsprechpartner_VN.Text & "','" & txtAnsprechpartner_NN.Text & "','" & txtEmail.Text & "','','" & txtLicensePlate.Text & "','" & LicenseNat & "','" & txtFahrzeugtyp.Text & "','" & txtAxles.Text & "','" & cardNum & "','" & txtMonat.Text & "','" & txtJahr.Text & "')", "FMZOLL") Then
|
|
MsgBox("Fehler beim Anlegen!")
|
|
Else
|
|
MsgBox("Bestellung wurde angelegt!")
|
|
Me.Close()
|
|
End If
|
|
|
|
|
|
'If s.updateBinding Then
|
|
' Dim SQL As New SQL
|
|
'If oldkfz <> txtLicensePlate.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= '" & txtLicensePlate.Text & "' WHERE KundenNr='" & kundenNr & "' AND KfzKennzeichen='" & oldkfz & "'", "SDL", True)
|
|
' SQL.doSQL("UPDATE [Kartenpool] SET KfzKennzeichen= '" & txtLicensePlate.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))
|
|
|
|
txtMonat.Text = dt.Rows(0).Item("Kartenablaufmonat").ToString
|
|
txtJahr.Text = dt.Rows(0).Item("Kartenablaufjahr").ToString
|
|
|
|
End If
|
|
|
|
|
|
Catch ex As Exception
|
|
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
|
|
End Try
|
|
|
|
End Sub
|
|
|
|
Private Function fktMod10(ByVal number As String) As Char
|
|
Dim sum As Integer = 0
|
|
Dim doubleDigit As Boolean = True
|
|
|
|
' Durchlaufen von rechts nach links
|
|
For i As Integer = number.Length - 1 To 0 Step -1
|
|
Dim digit As Integer = CInt(number(i).ToString())
|
|
|
|
If doubleDigit Then
|
|
digit *= 2
|
|
If digit > 9 Then digit -= 9
|
|
End If
|
|
|
|
sum += digit
|
|
doubleDigit = Not doubleDigit
|
|
Next
|
|
|
|
Dim check As Integer = (10 - (sum Mod 10)) Mod 10
|
|
Return check.ToString()(0)
|
|
End Function
|
|
|
|
|
|
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 : btnNew.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
|
|
btnNew.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("MDM_MAUTBOXEN_bearbeiten", Me) Then
|
|
MsgBox("Keine Berechtigung!")
|
|
Me.Close()
|
|
End If
|
|
|
|
KdSearchBox1.initKdBox(Me)
|
|
|
|
MyComboBox1.Items.Add(New MyListItem("N", "N")) '"N" -> Neue Bestellung
|
|
MyComboBox1.changeItem("N")
|
|
|
|
cbxSprache.Items.Add(New MyListItem("", ""))
|
|
cbxSprache.Items.Add(New MyListItem("deutsch", "DE"))
|
|
cbxSprache.Items.Add(New MyListItem("englisch", "EN"))
|
|
cbxSprache.Items.Add(New MyListItem("italienisch", "IT"))
|
|
cbxSprache.Items.Add(New MyListItem("kroatisch", "HR"))
|
|
cbxSprache.Items.Add(New MyListItem("tschechisch", "CZ"))
|
|
cbxSprache.Items.Add(New MyListItem("ungarisch", "HU"))
|
|
MyComboBox1.changeItem("")
|
|
|
|
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)
|
|
|
|
If cbxLandKz.Items.Count > 0 Then
|
|
MyComboBox2.Items.AddRange(cbxLandKz.Items.Cast(Of VERAG_PROG_ALLGEMEIN.MyListItem).ToArray())
|
|
MyComboBox3.Items.AddRange(cbxLandKz.Items.Cast(Of VERAG_PROG_ALLGEMEIN.MyListItem).ToArray())
|
|
End If
|
|
|
|
|
|
initKunde()
|
|
|
|
End Sub
|
|
|
|
Private Sub KdSearchBox1_PropertyChanged(sender As Object, e As System.ComponentModel.PropertyChangedEventArgs) Handles KdSearchBox1.PropertyChanged
|
|
initKunde()
|
|
End Sub
|
|
|
|
Private Sub setDefaultValues()
|
|
|
|
'Anzahl der Achsen des Zugfahrzeuges. Fahrzeuge mit mehr als 4 Achsen sind mit 4 zu deklarieren.
|
|
If txtAxles.Text = "" Then
|
|
txtAxles.Text = "2"
|
|
End If
|
|
|
|
'Fahrzeugtyp (Busse und Wohnmobile sind als "Bus", alle anderen mautpflichtigen Fahrzeuge als "LKW" zu deklarieren).
|
|
If txtFahrzeugtyp.Text = "" Then
|
|
txtFahrzeugtyp.Text = "LKW"
|
|
End If
|
|
|
|
'Firmenadresse: Strasse; Sollte es keine Strasseninformation geben, so ist dieses Feld mit einem "-" zu füllen.
|
|
If txtStrasse.Text = "" Then
|
|
txtStrasse.Text = "-"
|
|
End If
|
|
|
|
'Firmenadresse: Hausnummer; Sollte es keine Hausnummer geben, so ist dieses Feld mit einem "-" zu füllen.
|
|
If txtStasseNr.Text = "" Then
|
|
txtStasseNr.Text = "-"
|
|
End If
|
|
|
|
|
|
End Sub
|
|
|
|
Private Function checkValues() As Boolean
|
|
|
|
If kunde Is Nothing And kundenNr < 0 Then
|
|
lblWarning.Text = "Bitte Kunden-Nr eingeben."
|
|
Return False
|
|
End If
|
|
|
|
|
|
If cbxKK.SelectedValue = "" Then
|
|
lblWarning.Text = "Bitte Kreditkarten-Nr eingeben."
|
|
Return False
|
|
End If
|
|
|
|
|
|
Dim PLZRegel As Integer = 0
|
|
Select Case Land2ISOcode
|
|
Case "BE" : PLZRegel = 2
|
|
Case "DZ", "DK", "DE", "FI", "FR", "GR", "IR", "IS", "IT", "HR", "KW", "LI", "LU", "MC", "NO", "AT", "RU", "CH", "RS", "SI", "ES", "TN", "TR", "UA", "HU", "CY" : PLZRegel = 4
|
|
Case "GB" : PLZRegel = 5
|
|
Case "NL", "PL", "PT", "SE", "SK", "CZ" : PLZRegel = 9
|
|
|
|
End Select
|
|
|
|
'PLZ-Regel PLZ-RegelBeschreibung
|
|
'1 Maximale Länge; keine Leerzeichen
|
|
'2 Numerisch; Maximale Länge; keine Leerzeichen
|
|
'3 Exakte Länge; keine Leerzeichen
|
|
'4 Numerisch; exakte Länge; keine Leerzeichen
|
|
'5 Maximale Länge
|
|
'6 Numerisch; maximale Länge
|
|
'7 Exakte Länge
|
|
'8 Numerisch; exakte Länge
|
|
'9 Länder-spezifisch (siehe PostleitzahlFormat)
|
|
|
|
Dim laengePLZ As Integer = 0
|
|
|
|
Select Case Land2ISOcode
|
|
|
|
Case "IS" : laengePLZ = 3
|
|
Case "BE", "DK", "LI", "LU", "NO", "AT", "CH", "SI", "TN", "HU", "CY" : laengePLZ = 4
|
|
Case "DZ", "DE", "FI", "FR", "GR", "IR", "IL", "IT", "HR", "KW", "MC", "RS", "ES", "TR", "UA" : laengePLZ = 5
|
|
Case "NL", "PL", "RU", "SE", "SK", "CZ" : laengePLZ = 6
|
|
Case "PT" : laengePLZ = 8
|
|
Case "GB" : laengePLZ = 9
|
|
End Select
|
|
|
|
|
|
Dim PLZFormat As String = ""
|
|
If PLZRegel = 9 Then
|
|
Select Case Land2ISOcode
|
|
Case "NL" : PLZFormat = "NNNN AA"
|
|
Case "PL" : PLZFormat = "NN-NNN"
|
|
Case "PT" : PLZFormat = "NNNN NNN oder NNNN"
|
|
Case "SE", "SK", "CZ" : PLZFormat = "NNN NN"
|
|
End Select
|
|
ElseIf PLZRegel = 2 Then
|
|
lblPLZRegel.Text = "Numerisch; keine LZ Max. Länge: " & laengePLZ
|
|
ElseIf PLZRegel = 4 Then
|
|
lblPLZRegel.Text = " Numerisch; keine LZ, genaue Länge: " & laengePLZ
|
|
ElseIf PLZRegel = 5 Then
|
|
lblPLZRegel.Text = "Max. Länge: " & laengePLZ
|
|
End If
|
|
|
|
If PLZFormat <> "" Then lblPLZRegel.Text &= PLZFormat
|
|
|
|
If txtPlz.Text <> "" AndAlso txtPlz.Text <> "-" Then
|
|
If laengePLZ > 0 AndAlso (txtPlz.Text.Length <> laengePLZ AndAlso PLZRegel = 4) OrElse (txtPlz.Text.Length > laengePLZ AndAlso (PLZRegel = 2 OrElse PLZRegel = 5)) Then
|
|
lblWarning.Text = "Die PLZ für " & Land2ISOcode & IIf(PLZRegel = 2 Or PLZRegel = 5, " darf max. ", " muss genau ") & laengePLZ & " Stellen besitzen!"
|
|
Return False
|
|
End If
|
|
End If
|
|
|
|
Dim licensePlate As String = txtLicensePlate.Text
|
|
|
|
If Not String.IsNullOrEmpty(licensePlate) Then
|
|
For i As Integer = 0 To licensePlate.Length - 1
|
|
Dim ch As Char = licensePlate(i)
|
|
If Not (Char.IsDigit(ch) OrElse (ch >= "A"c AndAlso ch <= "Z"c) OrElse ch = " "c OrElse ch = "-"c) Then
|
|
MessageBox.Show("Ungültiges Zeichen: " & ch, "Eingabeprüfung", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
|
Return False
|
|
Exit For
|
|
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
Dim cardNum As String = cbxKK.SelectedValue
|
|
|
|
If Not String.IsNullOrEmpty(cardNum) Then
|
|
Dim mainPart As String = cardNum.Substring(0, cardNum.Length - 1)
|
|
Dim checkDigit As Char = cardNum(cardNum.Length - 1)
|
|
|
|
If checkDigit <> fktMod10(mainPart) Then
|
|
MessageBox.Show("CardNum ungültig. Prüfziffernfehler!", "Eingabeprüfung", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
|
Return False
|
|
End If
|
|
End If
|
|
|
|
Return True
|
|
End Function
|
|
|
|
|
|
Private Sub initKunde()
|
|
|
|
If kundenNr < 0 Then
|
|
|
|
|
|
If adresse IsNot Nothing Then
|
|
|
|
txtName.Text = If(adresse.Name_1, "")
|
|
txtName2.Text = If(adresse.Name_2, "")
|
|
|
|
StrasseNrAufteilen(adresse.Straße, txtStrasse.Text, txtStasseNr.Text)
|
|
|
|
txtOrt.Text = If(adresse.Ort, "")
|
|
txtPlz.Text = If(adresse.PLZ, "")
|
|
cbxLandKz.changeItem(If(adresse.LandKz, ""))
|
|
txtAnsprechpartnerAnrede.Text = adresse.Anrede
|
|
txtAnsprechpartner_VN.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, "")
|
|
txtName2.Text = If(AD.Name_2, "")
|
|
|
|
StrasseNrAufteilen(AD.Straße, txtStrasse.Text, txtStasseNr.Text)
|
|
|
|
txtOrt.Text = If(AD.Ort, "")
|
|
txtPlz.Text = If(AD.PLZ, "")
|
|
cbxLandKz.changeItem(If(AD.LandKz, ""))
|
|
txtAnsprechpartnerAnrede.Text = AD.Anrede
|
|
txtAnsprechpartner_VN.Text = AD.Ansprechpartner
|
|
|
|
initdgv()
|
|
|
|
End If
|
|
End If
|
|
|
|
If cbxLandKz._value <> "" Then getLand(cbxLandKz._value, True)
|
|
|
|
setDefaultValues()
|
|
|
|
|
|
End Sub
|
|
|
|
Private Function getLand(landkz As String, Optional setISO2Global As Boolean = False) As String
|
|
|
|
Dim LandISO2 As String = ""
|
|
If landkz.Length = 2 Then
|
|
LandISO2 = landkz
|
|
ElseIf landkz.Length = 3 Then
|
|
LandISO2 = VERAG_PROG_ALLGEMEIN.cProgramFunctions.getISO2LandFromISO3Land(landkz)
|
|
ElseIf landkz.Length = 1 Then
|
|
LandISO2 = VERAG_PROG_ALLGEMEIN.cProgramFunctions.getISO2LandFromISO1Land(landkz)
|
|
End If
|
|
|
|
If setISO2Global Then
|
|
Land2ISOcode = LandISO2
|
|
|
|
End If
|
|
|
|
Return LandISO2
|
|
|
|
'MyComboBox3.changeItem(LandISO2) 'License plate Nationality
|
|
'MyComboBox2.changeItem(LandISO2) 'CompanyCountryAbbr
|
|
|
|
End Function
|
|
|
|
Private Sub checkAndSetKKNr(adressenNr As String)
|
|
|
|
|
|
Dim strCardNum As String
|
|
|
|
'' Take the last 6 digits of AdressenNr, padded with leading zeros
|
|
'strCardNum = "990001" & Right(adressenNr.PadLeft(6, "0"c), 6) & "0001"
|
|
|
|
'' Append the Mod10 check digit
|
|
'strCardNum &= fktMod10(strCardNum)
|
|
|
|
'' Assign to CardNum TextBox
|
|
'txtCardNum.Text = strCardNum
|
|
|
|
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
|
|
|
|
Private Sub StrasseNrAufteilen(Strasse_input As String, ByRef companyStreet_output As String, ByRef companyNumber_output As String)
|
|
|
|
Dim companyStreet As String = "-"
|
|
Dim companyNumber As String = ""
|
|
|
|
For i As Integer = 0 To Strasse_input.Length - 1
|
|
If Char.IsDigit(Strasse_input(i)) Then
|
|
companyStreet = Strasse_input.Substring(0, i).Trim()
|
|
companyNumber = Strasse_input.Substring(i).Trim()
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
If String.IsNullOrWhiteSpace(companyStreet) Then companyStreet = "-"
|
|
|
|
companyStreet_output = companyStreet
|
|
companyNumber_output = companyNumber
|
|
|
|
End Sub
|
|
|
|
Private Sub cbxLandKz_SelectedValueChanged(sender As Object, e As EventArgs) Handles cbxLandKz.SelectedValueChanged
|
|
If cbxLandKz._value <> "" Then getLand(cbxLandKz._value, True)
|
|
lblPLZRegel.Text = ""
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
' frm_GOX_BOX_Bestellung (FMZOLL)
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
'Option Compare Database
|
|
'Option Explicit On
|
|
|
|
' 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
|
|
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
' frm_GO_BOX_Bestellvorgang (FMZOLL)
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
'-------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
' 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 |