Files
SDL/SDL/ZOLLSYSTEM/DAKOSY/ATLAS/EZA/usrCntlATLAS_EZA.vb

2168 lines
96 KiB
VB.net
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

Imports DAKOSY_Worker
Imports Tamir
Imports Tamir.SharpSsh
Imports Microsoft.Office.Interop
Imports VERAG_PROG_ALLGEMEIN
Imports javax.xml.bind.annotation
Imports System.Globalization
Public Class usrCntlATLAS_EZA
Property ALLG As usrCntlATLAS_EZA_Allg
Property ADRESSEN As usrCntlATLAS_EZA_Adressen
Property POSITIONEN As usrCntlATLAS_EZA_Positionen
Property DV1 As usrCntlATLAS_EZA_DV1
Property Jahr2Stellig As Integer
Property zusatz As String
Property BezugsNr As String = ""
Dim sentToDakosy = False
Property AVISO As VERAG_PROG_ALLGEMEIN.cAviso
Property SENDUNG As VERAG_PROG_ALLGEMEIN.cSendungen
Dim cDy_ART As String = "EZA"
Dim EZA As cDakosyEZA = Nothing
Dim DY_ANM As cDakosy_Zollanmeldungen = Nothing
Dim FIRMA_DY = VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA
Property isSTAMMREF As Boolean = False
Property STAMMREF As String = ""
Sub New(DY_ANM As cDakosy_Zollanmeldungen, AVISO As VERAG_PROG_ALLGEMEIN.cAviso, SENDUNG As VERAG_PROG_ALLGEMEIN.cSendungen, Jahr2Stellig As Integer, Optional zusatz As String = "", Optional isSTAMMREF As Boolean = False, Optional STAMMREF As String = "")
' Dieser Aufruf ist für den Designer erforderlich.
InitializeComponent()
' Me.cDy_ART = If(ART = "NCTS", "T2", ART)
Me.Jahr2Stellig = Jahr2Stellig
Me.zusatz = zusatz
Me.AVISO = AVISO
Me.SENDUNG = SENDUNG
Me.DY_ANM = DY_ANM
Me.isSTAMMREF = isSTAMMREF
Me.STAMMREF = STAMMREF
If DY_ANM IsNot Nothing Then
Me.EZA = DAKOSY_Worker.cDakosyEZA.LOADByAnmIDFull(DY_ANM.dy_Id, True)
If Me.EZA IsNot Nothing AndAlso Me.EZA.eza_firma IsNot Nothing Then Me.FIRMA_DY = Me.EZA.eza_firma
End If
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
End Sub
Sub New(EZA As cDakosyEZA, Optional isSTAMMREF As Boolean = False, Optional STAMMREF As String = "")
InitializeComponent()
Me.EZA = EZA
DY_ANM = New cDakosy_Zollanmeldungen(EZA.eza_dyaAnmID)
Me.isSTAMMREF = isSTAMMREF
Me.STAMMREF = STAMMREF
If DY_ANM.dy_AvisoId > 0 Then
Dim AV As New VERAG_PROG_ALLGEMEIN.cAvisoDAL
AVISO = AV.LesenAviso(DY_ANM.dy_AvisoId, "")
End If
If DY_ANM.dy_SendungsId > 0 Then
SENDUNG = New VERAG_PROG_ALLGEMEIN.cSendungen(DY_ANM.dy_SendungsId)
End If
End Sub
Sub New(ART As String, AvisoId As Integer, SENDUNGS_ID As Integer, Jahr2Stellig As Integer, Optional zusatz As String = "", Optional isSTAMMREF As Boolean = False, Optional STAMMREF As String = "")
' Dieser Aufruf ist für den Designer erforderlich.
InitializeComponent()
Me.cDy_ART = If(ART <> "", ART, "EX")
If AvisoId > 0 Then
Dim AV As New VERAG_PROG_ALLGEMEIN.cAvisoDAL
AVISO = AV.LesenAviso(AvisoId, "")
End If
If SENDUNGS_ID > 0 Then
SENDUNG = New VERAG_PROG_ALLGEMEIN.cSendungen(SENDUNGS_ID)
End If
Me.isSTAMMREF = isSTAMMREF
Me.STAMMREF = STAMMREF
Me.Jahr2Stellig = Jahr2Stellig
Me.zusatz = zusatz
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
End Sub
Sub New(ART As String, Aviso As VERAG_PROG_ALLGEMEIN.cAviso, SENDUNG As VERAG_PROG_ALLGEMEIN.cSendungen, Jahr2Stellig As Integer, Optional zusatz As String = "", Optional isSTAMMREF As Boolean = False, Optional STAMMREF As String = "", Optional FIRMA_DY As String = "")
' Dieser Aufruf ist für den Designer erforderlich.
InitializeComponent()
Me.cDy_ART = If(ART <> "", ART, "EX")
Me.AVISO = Aviso
Me.SENDUNG = SENDUNG
Me.Jahr2Stellig = Jahr2Stellig
Me.zusatz = zusatz
Me.isSTAMMREF = isSTAMMREF
Me.STAMMREF = STAMMREF
If FIRMA_DY <> "" Then Me.FIRMA_DY = FIRMA_DY
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
End Sub
Function getBezugsnr(ByRef BezugsNr)
Dim BezugsNrTmp = ""
Select Case FIRMA_DY
Case "UNISPED"
If If(SENDUNG.tblSnd_DakosyRef, "") <> "" Then
BezugsNrTmp = SENDUNG.tblSnd_DakosyRef
Else
BezugsNrTmp = SENDUNG.FilialenNr & "/" & SENDUNG.AbfertigungsNr
End If
Case Else
BezugsNrTmp = SENDUNG.FilialenNr & "/" & SENDUNG.AbfertigungsNr '& If(zusatz <> "", "/" & zusatz, "") 'zusatz ' & "/" & Jahr2Stellig
End Select
BezugsNr = BezugsNrTmp
zusatz = "A"
'Soloagne bis die Bezugsnummer noch nicht existiert
While DAKOSY_Worker.cDakosy_Zollanmeldungen.ExistsBezugsNr(BezugsNr) 'IsNot Nothing
BezugsNr = SENDUNG.FilialenNr & "/" & SENDUNG.AbfertigungsNr & "/" & zusatz
If zusatz.Length = 1 Then
zusatz = Chr(Asc(zusatz.ToString) + 1)
Else
zusatz = zusatz.Substring(0, 1) & Chr(Asc(zusatz.Substring(0, 2).ToString) + 1)
End If
If zusatz = "Z" Then zusatz = "AA"
End While
lblBezugsnummer.Text = BezugsNr
Return BezugsNr
End Function
Function getKdnr(ByRef art) As Integer
Try
If ADRESSEN IsNot Nothing Then
Select Case art
Case "EMPF" : Return ADRESSEN.usrCntl_Empfaenger.kdFirma.KdNr_value
Case "ABS" : Return ADRESSEN.usrCntl_Versender.kdFirma.KdNr_value
Case "ANM" : Return ADRESSEN.usrCntl_Anmelder.kdFirma.KdNr_value
Case "VERTR" : Return ADRESSEN.usrCntl_Vertretener.kdFirma.KdNr_value
Case "VERTRANM" : Return ADRESSEN.usrCntl_VertreterAnmelder.kdFirma.KdNr_value
End Select
End If
Catch ex As Exception
Return -1
End Try
End Function
Private Sub usrCntlATLAS_Load(sender As Object, e As EventArgs) Handles Me.Load
cboDakosyAction.Items.Clear()
cboDakosyAction.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Neuen Datensatz erstellen", DY_ObjektAktion.OBJ_CREATE))
cboDakosyAction.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Vohr. DS ändern", DY_ObjektAktion.OBJ_CHANGE))
cboDakosyAction.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Vorh. DS stornieren", DY_ObjektAktion.OBJ_CANCEL))
cboDakosyAction.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Datensatz an ZOLL senden", DY_ObjektAktion.OBJ_SEND))
cboDakosyAction.changeItem(DY_ObjektAktion.OBJ_CREATE)
ADRESSEN = New usrCntlATLAS_EZA_Adressen(EZA)
ALLG = New usrCntlATLAS_EZA_Allg(EZA)
POSITIONEN = New usrCntlATLAS_EZA_Positionen(EZA, Me)
DV1 = New usrCntlATLAS_EZA_DV1(EZA)
Select Case FIRMA_DY
Case "VERAG" : txtDyMandant.Text = "VERG"
txtDyNiederlassung.Text = VERAG_PROG_ALLGEMEIN.cAllgemein.NIEDERLASSUNG
' Select Case VERAG_PROG_ALLGEMEIN.cAllgemein.NIEDERLASSUNG
'Case "SUB" : txtDyNiederlassung.Text = "VERG"
'Case "SUW" : txtDyNiederlassung.Text = "ATIL"
''Case "SBG" : txtDyNiederlassung.Text = "IMEX"
'Case "NEU" : txtDyNiederlassung.Text = "IMEX"
'Case "NKD" : txtDyNiederlassung.Text = "IMEX"
'End Select
Case "AMBAR" : txtDyMandant.Text = "ATIL" : txtDyNiederlassung.Text = "AMBWO"
Case "ATILLA" : txtDyMandant.Text = "ATIL" : txtDyNiederlassung.Text = "SUW"
Case "UNISPED" : txtDyMandant.Text = "UNAT" : txtDyNiederlassung.Text = "ATSPED"
Case "IMEX" : txtDyMandant.Text = "IMEX" : txtDyNiederlassung.Text = "IME"
End Select
cboStammreferenz.fillWithSQL("SELECT [dySr_Stammreferenz],[dySr_Bezeichnung] FROM [tblDakosy_Stammreferenzen] WHERE dySr_Land='DE' AND dySr_Verfahren='EZA' and dySr_dy_Mandant='" & txtDyMandant.Text & "' and dySr_dy_Niederlassung='" & txtDyNiederlassung.Text.Replace("DTB", "SUB") & "' and dySr_visible=1", False, "FMZOLL", True)
cboStammreferenz.changeItem("")
If isSTAMMREF Then
Me.BezugsNr = "STAMMREFERENZ"
If EZA Is Nothing Then EZA = New cDakosyEZA
EZA.eza_ObjectName = BezugsNr
Button1.Enabled = False
cboDakosyAction.Enabled = False
Else
If EZA Is Nothing Then ' NEUE ZOLLANMELDUNG
Dim kdnr As Object = Nothing
If SENDUNG IsNot Nothing AndAlso SENDUNG.tblSnd_EmpfaengerKdNr > 0 Then
kdnr = SENDUNG.tblSnd_EmpfaengerKdNr
End If
Dim f As New frmDakosyStammreferenz("DE", "EZA", False, kdnr,, FIRMA_DY)
Dim Stammreferenz = Nothing
If f.ShowDialog(Me) Then
Stammreferenz = f.STAMMREF
sentToDakosy = f.sentToDakosy
End If
Try
BezugsNr = getBezugsnr(BezugsNr)
Catch ex As Exception
MsgBox(ex.Message & ex.StackTrace)
End Try
EZA = cDakosyEZA.LOADByBezugsNr(BezugsNr, True)
If EZA Is Nothing Then
'Falls zur BezugsNr schon ein Eintrag in der DB vorhanden ist
EZA = cDakosyEZA.LOADByAnmIDFull(f.STAMMREF_DYID, True) ' DyID --> Falls bei der Stammreferenz eine Vorlage hinterlegt ist!
If EZA IsNot Nothing Then
'Stmmreferenz - Werte zurücksetzen, damit nicht falsch übergeben
EZA.eza_dyaAnmID = -1
EZA.eza_Id = -1
Else
EZA = New cDakosyEZA
End If
'Wenn bei der Stammref eine andere NL ausgewählt wurde, wird dies hier korrigiert (zb. IMEX / GLOBAL!):
If f.nl <> txtDyNiederlassung.Text Then
txtDyNiederlassung.Text = f.nl
cboStammreferenz.fillWithSQL("SELECT [dySr_Stammreferenz],[dySr_Bezeichnung] FROM [tblDakosy_Stammreferenzen] WHERE dySr_Land='DE' AND dySr_Verfahren='EZA' and dySr_dy_Mandant='" & txtDyMandant.Text & "' and dySr_dy_Niederlassung='" & txtDyNiederlassung.Text & "' and dySr_visible=1", False, "FMZOLL", True)
End If
loaddataFromAVISO(EZA)
cboStammreferenz.changeItem(Stammreferenz)
End If
'eza_OUT
Else
' eza_OUT is ot nothing
Me.BezugsNr = EZA.eza_ObjectName
'MsgBox(eza_OUT.eza_Hauptverpflichteter_Name)
End If
End If
If If(EZA.eza_firma, "") = "" Then If FIRMA_DY <> "" Then EZA.eza_firma = FIRMA_DY
' If EZA.ncts_ArtAnmeldung Is Nothing Or EZA.ncts_ArtAnmeldung = "" Then
'EZA.ncts_ArtAnmeldung = "T2"
'End If
'hinzufügen, damit alle Controls richtig geladen und initialisiert werden:s
Me.SplitContainer.Panel2.Controls.Add(ALLG)
Me.SplitContainer.Panel2.Controls.Add(POSITIONEN)
Me.SplitContainer.Panel2.Controls.Add(ADRESSEN)
Me.SplitContainer.Panel2.Controls.Add(DV1)
AddHandler ALLG.DV1_changed, Sub(dv1)
btnDV1.Visible = dv1
End Sub
' MsgBox(EZA.ncts_Hauptverpflichteter_Name)
'Werte setzen:
ADRESSEN.setValues(EZA)
ALLG.setValues(EZA)
POSITIONEN.setValues(EZA)
DV1.setValues(EZA)
'Controls wieder entfernen:
Me.SplitContainer.Panel2.Controls.Clear()
'If ALLG.txtRechnungspreis.Text = "" Then ALLG.txtRechnungspreis.Text = BezugsNr
' ADRESSEN.CreateControl()
For Each c In MyFlowLayoutPanel1.Controls
If c.GetType.ToString = GetType(System.Windows.Forms.Button).ToString Then
AddHandler DirectCast(c, System.Windows.Forms.Button).Click, AddressOf buttonClick
End If
Next
SplitContainer.Panel2.Controls.Add(ALLG)
lblBezugsnummer.Text = BezugsNr
ALLG.Dock = DockStyle.Fill
ADRESSEN.Dock = DockStyle.Fill
POSITIONEN.Dock = DockStyle.Fill
DV1.Dock = DockStyle.Fill
AddHandler POSITIONEN.RohmasseChanged, Sub(rohmasse)
Label5.Text = rohmasse.ToString("N2") & " kg"
End Sub
AddHandler POSITIONEN.PosAnzChanged, Sub(anz)
Label3.Text = anz
End Sub
If sentToDakosy Then
Try
Me.Button1.PerformClick()
Me.FindForm.Close()
Catch
End Try
End If
Try
If Not VERAG_PROG_ALLGEMEIN.cBerechtignunen.CHECK_BERECHTIGUNG_bool("ZOLL_DakosyZA_AVISO_Edit", "AVISO") Then
Me.FindForm.Close()
End If
Catch
End Try
End Sub
Sub buttonClick(sender As Object, e As EventArgs) 'HANDLED
Dim btn As System.Windows.Forms.Button = DirectCast(sender, System.Windows.Forms.Button)
For Each c In MyFlowLayoutPanel1.Controls
If c.GetType.ToString = GetType(System.Windows.Forms.Button).ToString Then
DirectCast(c, System.Windows.Forms.Button).BackColor = Drawing.Color.White
DirectCast(c, System.Windows.Forms.Button).ForeColor = Drawing.Color.Black
End If
Next
btn.BackColor = Drawing.Color.SteelBlue 'Drawing.Color.FromArgb(0, 54, 128)
btn.ForeColor = Drawing.Color.White
SplitContainer.Panel2.Controls.Clear()
If btn Is btnAllgemein Then
SplitContainer.Panel2.Controls.Add(ALLG)
ElseIf btn Is btnAdressen Then
SplitContainer.Panel2.Controls.Add(ADRESSEN)
ElseIf btn Is btnPositionen Then
SplitContainer.Panel2.Controls.Add(POSITIONEN)
ElseIf btn Is btnDV1 Then
SplitContainer.Panel2.Controls.Add(DV1)
End If
End Sub
Sub loaddataFromAVISO(ByRef cdy As cDakosyEZA)
Try
'==> VORBLENDUNG:
' Dim cdy As New cDakosyEZA
cdy.eza_ObjectName = BezugsNr
' cdy.EZA_AbgangsDienststellennummer = "DE004102"
'frmZollanmeldung.setAbgangszollstelle(cdy.eza_Eingangszollstelle, AVISO)
frmZollanmeldung.setZollstelle(cdy.eza_AdressierteZollstelle, AVISO)
If cdy.eza_AdressierteZollstelle IsNot Nothing AndAlso cdy.eza_AdressierteZollstelle.Length = 8 Then 'nur 4 stellen erlaubt!! 'DE00 fällt weg
EZA.eza_AdressierteZollstelle = cdy.eza_AdressierteZollstelle.Substring(4, 4)
End If
' cdy.EZA_VersendungsLandCode = "DE"
cdy.eza_dyaArt = cDy_ART
If AVISO IsNot Nothing Then
' cdy.EZA_Befoerderungsmittel_KennzeichenAbgang = AVISO.LKW_Nr
' cdy.EZA_Befoerderungsmittel_KennzeichenGrenzueberschreitend = "X"
End If
' Dim AD As New VERAG_PROG_ALLGEMEIN.cAdressen(712255) ' VERAG Neuhaus
' Dim KD As New VERAG_PROG_ALLGEMEIN.cKunde(712255) ' VERAG Neuhaus
If False Then
If AVISO.Frächter_KdNr IsNot Nothing AndAlso IsNumeric(AVISO.Frächter_KdNr) AndAlso AVISO.Frächter_KdNr > 0 Then
Dim AD_Befoerderer As New VERAG_PROG_ALLGEMEIN.cAdressen(AVISO.Frächter_KdNr) ' Befoerderer
Dim KD_Befoerderer As New VERAG_PROG_ALLGEMEIN.cKunde(AVISO.Frächter_KdNr) ' Befoerderer
Else
' cdy.EZA_SumA_Befoerderer_Name = If(AVISO.Frächter, "")
End If
If SENDUNG IsNot Nothing Then
Dim p As New DAKOSY_Worker.cDakosy_EZA_Warenposition
p.ezaWP_Warenbezeichnung = SENDUNG.tblSnd_Warenbezeichnung
If SENDUNG.tblSnd_Colli IsNot Nothing AndAlso IsNumeric(SENDUNG.tblSnd_Colli) Then
' Dim pk As New DAKOSY_Worker.cDakosy_EZA_WarenpositionPackstuecke
' pk.EZAWpPk_PackstueckeAnzahl = SENDUNG.tblSnd_Colli
' pk.EZAWpPk_Verpackungsart = "PK"
' p.EZAWP_PACKSTUECKE.Add(pk)
End If
p.ezaWP_Rohmasse = SENDUNG.tblSnd_Gewicht
p.ezaWP_Warenbezeichnung = SENDUNG.tblSnd_Warenbezeichnung
cdy.eza_WARENPOS.Add(p)
End If
End If
If SENDUNG IsNot Nothing Then
'Test Vorpapier:
If If(SENDUNG.tblSnd_Vorpapier, "") <> "" Then
EZA.eza_VorpapierArtCode = "T1"
EZA.eza_VorpapierNr = SENDUNG.tblSnd_Vorpapier
End If
Dim Vorsystem = False
If (SENDUNG.VORSYSTEM IsNot Nothing) AndAlso MsgBox("Möchten Sie die Daten aus dem Vorsystem laden?", vbYesNoCancel) Then
Try
Dim SH As New VERAG_PROG_ALLGEMEIN.cVERAG_in_eza_FULL(CInt(SENDUNG.VORSYSTEM_Id))
If SH IsNot Nothing Then
Dim ABFERTIGUNGSART = 1 'DEFAULT Fiskal?
EZA.eza_GesamtRohmasse = SH.EZA.TotGrossWeight
If If(SH.EZA.Incoterm, "") <> "" Then
EZA.eza_LieferbedingungCode = SH.EZA.Incoterm
End If
'EZA.pack= SH.EZA.TotPackage
'EZA.eza_Rechnungspreis = SH.EZA.TotGrossWeight
'EZA.eza_Rechnungswaehrung = SENDUNG.tblSnd_WarenwertWaehrung
' If If(SH.EZA.TransportModeBorder, "") <> "" Then EZA.eza_BeförderungsmittelGrenzeArt = SH.EZA.TransportModeBorder
'If If(SH.EZA.TransportBorderType, "") <> "" Then EZA.bef = SH.EZA.TransportBorderType
If If(SH.EZA.PrePaperCode, "") <> "" Then EZA.eza_VorpapierArtCode = SH.EZA.PrePaperCode
If If(SH.EZA.PrePaperNr, "") <> "" Then EZA.eza_VorpapierNr = SH.EZA.PrePaperNr
If If(SH.EZA.CountryCodeDeparture, "") <> "" Then EZA.eza_VersendungsLandCode = SH.EZA.CountryCodeDeparture
If If(SH.EZA.TransportModeBorder, "") <> "" Then EZA.eza_VerkehrszweigInland = SH.EZA.TransportModeBorder
If If(SH.EZA.TransportModeBorder, "") <> "" Then EZA.eza_VerkehrszweigGrenze = SH.EZA.TransportModeBorder
If If(SH.EZA.TransportBorderType, "") <> "" Then EZA.eza_BeförderungsmittelGrenzeArt = SH.EZA.TransportBorderType
'If If(AD.ezaAd_LandCode, "") = "DE" And AD.ezaAd_PLZ IsNot Nothing Then
' EZA.eza_Bestimmungsbundesland = VERAG_PROG_ALLGEMEIN.cDEBundeslaenderPLZ.LOADBundeslandCode_ByPLZ(AD.ezaAd_PLZ)
'ElseIf If(AD.ezaAd_LandCode, "") <> "" Then
' EZA.eza_Bestimmungsbundesland = 25
'End If
Dim InvoiceSum As Double = 0.0
Dim InvoiceCurr As String = ""
For Each SH_POS In SH.EZA.POSITIONS
Dim EZA_POS As New DAKOSY_Worker.cDakosy_EZA_Warenposition
EZA_POS.ezaWP_PackstueckAnzahl = SH_POS.NumberOfPackages
EZA_POS.ezaWP_Rohmasse = SH_POS.GrossWeight
EZA_POS.ezaWP_Eigenmasse = SH_POS.NetWeight
EZA_POS.ezaWP_Warenbezeichnung = SH_POS.GoodsDescription
EZA_POS.ezaWP_WarennummerEZT = SH_POS.GoodsTariff
EZA_POS.ezaWP_UrsprungslandCode = SH_POS.OriginCountryCode
'If If(SH_POS.KindOfPackages, "") <> "" Then EZA_POS.ezaWP_PackstueckArt = SH_POS.KindOfPackages
EZA_POS.ezaWP_PackstueckArt = "PK"
If SH_POS.ItemInvoiceAmount IsNot Nothing Then
EZA_POS.ezaWP_Artikelpreis = SH_POS.ItemInvoiceAmount
EZA_POS.ezaWP_ArtikelpreisWaehrung = SH_POS.ItemInvoiceCurrency
EZA_POS.ezaWP_AHStatWert = SH_POS.ItemInvoiceAmount
InvoiceSum += CDbl(SH_POS.ItemInvoiceAmount)
If SH_POS.ItemInvoiceCurrency = "" Then
InvoiceCurr = SH_POS.ItemInvoiceCurrency
ElseIf SH_POS.ItemInvoiceCurrency <> InvoiceCurr Then
InvoiceCurr = "XXX" ' Wenn währung unterschiedlich XX --> kein Übertrag
End If
End If
For Each SH_POS_DOC In SH_POS.DOCUMENTS
Dim bool_add = False
Dim EZA_POS_DOC As New DAKOSY_Worker.cDakosy_EZA_WarenpositionVorgelegteUnterlagen
EZA_POS_DOC.ezaWpUl_DatumAusstellung = SH_POS_DOC.DocumentDate
EZA_POS_DOC.ezaWpUl_Nummer = SH_POS_DOC.DocumentNr
Select Case SH_POS_DOC.DocumentType
Case "CMR" : EZA_POS_DOC.ezaWpUl_Art = "7HHF" : EZA_POS_DOC.ezaWpUl_Bereich = "4" : EZA_POS_DOC.ezaWpUl_VorlageKz = "J" : bool_add = True
Case "INV" : EZA_POS_DOC.ezaWpUl_Art = "N380" : EZA_POS_DOC.ezaWpUl_Bereich = "4" : EZA_POS_DOC.ezaWpUl_VorlageKz = "J" : bool_add = True
Case "ATR" : EZA_POS_DOC.ezaWpUl_Art = "N018" : EZA_POS_DOC.ezaWpUl_Bereich = "6" : EZA_POS_DOC.ezaWpUl_VorlageKz = "J" : bool_add = True
' Case "EX" : EZA_POS_DOC.ezaWpUl_Art = "N380": EZA_POS_DOC.ezaWpUl_Bereich = "4
End Select
If bool_add Then EZA_POS.ezaWP_UNTERLAGEN.Add(EZA_POS_DOC)
Next
EZA.eza_WARENPOS.Add(EZA_POS)
Next
EZA.eza_Rechnungspreis = InvoiceSum
' If InvoiceCurr <> "XXX" Then EZA.eza_Rechnungswaehrung = InvoiceCurr
If If(SH.EZA.InvoiceCurrency, "") <> "" Then EZA.eza_Rechnungswaehrung = SH.EZA.InvoiceCurrency
Dim LieferbedingungOrtAbsedner = ""
Dim LieferbedingungOrtEmpfaenger = ""
For Each SH_AD In SH.EZA.ADDRESS
Dim EZA_AD As New DAKOSY_Worker.cDakosy_EZA_Adressen
EZA_AD.ezaAd_AdressTyp = SH_AD.AddressCode
EZA_AD.ezaAd_LandCode = SH_AD.CountryCode
EZA_AD.ezaAd_NameFirma1 = SH_AD.Name1
EZA_AD.ezaAd_NameFirma2 = SH_AD.Name2
EZA_AD.ezaAd_NameFirma3 = SH_AD.Name3
EZA_AD.ezaAd_StrasseHausNr1 = SH_AD.Street1
EZA_AD.ezaAd_StrasseHausNr2 = SH_AD.Street2
EZA_AD.ezaAd_Ort = SH_AD.City
EZA_AD.ezaAd_PLZ = SH_AD.PostalCode
EZA_AD.ezaAd_UStIDAnmelder = SH_AD.UStID
If EZA_AD.ezaAd_AdressTyp = "CN" Then 'EMPFÄNGER
EZA_AD.ezaAd_TeilnehmerEORI = SH_AD.EORI
EZA_AD.ezaAd_TeilnehmerNLNR = SH_AD.NLNR
If If(EZA_AD.ezaAd_LandCode, "") = "DE" And EZA_AD.ezaAd_PLZ IsNot Nothing Then
EZA.eza_Bestimmungsbundesland = VERAG_PROG_ALLGEMEIN.cDEBundeslaenderPLZ.LOADBundeslandCode_ByPLZ(EZA_AD.ezaAd_PLZ)
ElseIf If(EZA_AD.ezaAd_LandCode, "") <> "" Then
EZA.eza_Bestimmungsbundesland = 25
End If
If If(EZA_AD.ezaAd_Ort, "") <> "" Then LieferbedingungOrtEmpfaenger = EZA_AD.ezaAd_Ort
End If
If EZA_AD.ezaAd_AdressTyp = "CZ" Then 'ABSENDER
If If(EZA_AD.ezaAd_Ort, "") <> "" Then LieferbedingungOrtAbsedner = EZA_AD.ezaAd_Ort
End If
EZA.eza_ADRESSEN.Add(EZA_AD)
Next
Select Case If(EZA.eza_LieferbedingungCode, "")
Case ""
Case "EXW", "FCA", "FOB", "FAS"
EZA.eza_LieferbedingungSchluessel = 1
EZA.eza_LieferbedingungOrt = LieferbedingungOrtAbsedner
Case Else
EZA.eza_LieferbedingungSchluessel = 3
EZA.eza_LieferbedingungOrt = LieferbedingungOrtEmpfaenger
End Select
Vorsystem = True
End If
Catch ex As Exception
MsgBox(ex.Message & ex.StackTrace)
End Try
End If
If Not Vorsystem Then
EZA.eza_GesamtRohmasse = SENDUNG.tblSnd_Gewicht
EZA.eza_Rechnungspreis = SENDUNG.tblSnd_Warenwert
EZA.eza_Rechnungswaehrung = SENDUNG.tblSnd_WarenwertWaehrung
If SENDUNG.tblSnd_Abfertigungsart_ID = 1 Then
If SENDUNG.tblSnd_EmpfaengerKdNr > 0 Then
Dim AD As New DAKOSY_Worker.cDakosy_EZA_Adressen
AD.ezaAd_AdressCode = SENDUNG.tblSnd_EmpfaengerKdNr
AD.ezaAd_AdressTyp = "CN"
Dim ADFmzoll As New VERAG_PROG_ALLGEMEIN.cAdressen(SENDUNG.tblSnd_EmpfaengerKdNr)
Dim KDFmzoll As New VERAG_PROG_ALLGEMEIN.cKunde(SENDUNG.tblSnd_EmpfaengerKdNr)
AD.ezaAd_NameFirma1 = ADFmzoll.Name_1
AD.ezaAd_NameFirma2 = ADFmzoll.Name_2
AD.ezaAd_StrasseHausNr1 = ADFmzoll.Straße
AD.ezaAd_PLZ = ADFmzoll.PLZ
AD.ezaAd_Ort = ADFmzoll.Ort
AD.ezaAd_LandCode = cProgramFunctions.getISO2Land(ADFmzoll.LandKz)
AD.ezaAd_TeilnehmerEORI = KDFmzoll.EORITIN
AD.ezaAd_TeilnehmerNLNR = KDFmzoll.EORITIN_NL
If If(AD.ezaAd_LandCode, "") <> "" Then
EZA.eza_Bestimmungsland = AD.ezaAd_LandCode
End If
If If(AD.ezaAd_LandCode, "") = "DE" And AD.ezaAd_PLZ IsNot Nothing Then
EZA.eza_Bestimmungsbundesland = VERAG_PROG_ALLGEMEIN.cDEBundeslaenderPLZ.LOADBundeslandCode_ByPLZ(AD.ezaAd_PLZ)
ElseIf If(AD.ezaAd_LandCode, "") <> "" Then
EZA.eza_Bestimmungsbundesland = 25
End If
cdy.eza_ADRESSEN.Add(AD)
End If
If SENDUNG.tblSnd_AbsenderKdNr > 0 Then
Dim AD As New DAKOSY_Worker.cDakosy_EZA_Adressen
AD.ezaAd_AdressCode = SENDUNG.tblSnd_AbsenderKdNr
AD.ezaAd_AdressTyp = "CZ"
Dim ADFmzoll As New VERAG_PROG_ALLGEMEIN.cAdressen(SENDUNG.tblSnd_AbsenderKdNr)
Dim KDFmzoll As New VERAG_PROG_ALLGEMEIN.cKunde(SENDUNG.tblSnd_AbsenderKdNr)
AD.ezaAd_NameFirma1 = ADFmzoll.Name_1
AD.ezaAd_NameFirma2 = ADFmzoll.Name_2
AD.ezaAd_StrasseHausNr1 = ADFmzoll.Straße
AD.ezaAd_PLZ = ADFmzoll.PLZ
AD.ezaAd_Ort = ADFmzoll.Ort
AD.ezaAd_LandCode = cProgramFunctions.getISO2Land(ADFmzoll.LandKz)
AD.ezaAd_TeilnehmerEORI = KDFmzoll.EORITIN
AD.ezaAd_TeilnehmerNLNR = KDFmzoll.EORITIN_NL
If If(AD.ezaAd_LandCode, "") <> "" Then
EZA.eza_VersendungsLandCode = AD.ezaAd_LandCode
End If
cdy.eza_ADRESSEN.Add(AD)
End If
End If
End If
End If
cdy.eza_KennzeichenNameBefoerderungsmittelAnkunft = AVISO.LKW_Nr
cdy.eza_BeförderungsmittelGrenzeStaatszugehörigkeitCode = AVISO.LKW_Nationalitaet
'cdy.EZA_BefoerderungsmittelGrenzeKennzeichen = AVISO.LKW_Nr
'cdy.EZA_Ausfuhrland = "DE"
' cdy.EZA_VerkehrszweigGrenze = "3"
' cdy.EZA_VerkehrszweigInland = "3"
' cdy.eza_BeförderungsmittelGrenzeArt = "33"
' cdy.EZA_Rechnungwaehrung = "EUR"
' NCTS= cdy
Catch ex As Exception
MsgBox(ex.StackTrace)
End Try
End Sub
Sub setValue(EZA)
BezugsNr = EZA.ncts_ObjectName
End Sub
Private Sub pnl_Paint(sender As Object, e As PaintEventArgs)
End Sub
Sub loadDYZollanmeldungen(Optional Status As String = "") ' + Speichern
If DY_ANM Is Nothing Then
DY_ANM = New cDakosy_Zollanmeldungen(EZA.eza_dyaAnmID)
End If
DY_ANM.dy_ART = ALLG.EZA_ART 'cDy_ART
DY_ANM.dy_BezugsNr = BezugsNr
DY_ANM.dy_AvisoId = If(AVISO Is Nothing, Nothing, AVISO.AvisoID)
DY_ANM.dy_SendungsId = If(SENDUNG Is Nothing, Nothing, SENDUNG.tblSnd_SendungID)
'Status?
DY_ANM.SAVE() 'Speichern, ID wird erzeugt
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Me.Refresh()
cboDakosyAction.Focus() 'nur, damit alle _value aktualisuiert sind...
If sentToDakosy OrElse vbYes = MsgBox("Sollen die Daten abgeschickt werden?" & vbNewLine & "Eine Änderung ist nur noch in der Dakosy Software möglich.", vbYesNoCancel) Then
' Dim cDyAnm As New cDakosy_Zollanmeldungen(cDy_ART, BezugsNr, AVISO.AvisoID, SENDUNG.tblSnd_SendungID)
loadDYZollanmeldungen()
If EZA IsNot Nothing Then
'Dim cDY As New cDakosyEZA(cDyAnm.dy_Id, cDyAnm.dy_Erstellung_SB)
EZA.eza_dyaAnmID = DY_ANM.dy_Id
EZA.eza_Erstellung_SB = DY_ANM.dy_Erstellung_SB
EZA.eza_LetzteBearbeitung = Now
EZA.eza_LetzteBearbeitung_SB = DY_ANM.dy_LetzteBearbeitung_SB
EZA.eza_firma = Me.FIRMA_DY
DAKOSY_Interface_SEND.loadInClass_VersandanmeldungEZA(EZA, Me, DY_ANM)
If Not EZA.SAVE_ALL() Then Exit Sub
Dim saveFile = ""
If DAKOSY_Interface_SEND.generateVersandanmeldungEZA(EZA, saveFile, cboDakosyAction._value) Then
If saveFile <> "" Then
If Not cDakosyFunftions.send_Data_To_Dakosy_FTP(saveFile, BezugsNr, DY_ANM.dy_Id, FIRMA_DY) Then
MsgBox("Sendefehler!")
Else
If SENDUNG IsNot Nothing Then SENDUNG.SET_VGMA() ' MA Vorgeschrieben in Sendung setzen.
End If
End If
End If
End If
DY_ANM.UPDATE_DATA()
'Beim Senden soll die Sendung überhnommen + tblSnd_VG_MA gesetzt werden --> damit gleich gesehen wird, dass der Akt in Bearbeitung ist.
DY_ANM.UPDATE_AVISO_SND(DY_ANM.dy_SendungsId)
Me.FindForm.Close()
End If
End Sub
Private Sub SpeichernToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SpeichernToolStripMenuItem.Click
Me.Refresh()
cboDakosyAction.Focus() 'nur, damit alle _value aktualisuiert sind...
' Dim cDyAnm As New cDakosy_Zollanmeldungen(cDy_ART, BezugsNr, If(AVISO Is Nothing, Nothing, AVISO.AvisoID), If(SENDUNG Is Nothing, Nothing, SENDUNG.tblSnd_SendungID))
loadDYZollanmeldungen()
If EZA IsNot Nothing Then
'Dim cDY As New cDakosyEZA(cDyAnm.dy_Id, cDyAnm.dy_Erstellung_SB)
EZA.eza_dyaAnmID = DY_ANM.dy_Id
EZA.eza_Erstellung_SB = DY_ANM.dy_Erstellung_SB
EZA.eza_LetzteBearbeitung = Now
EZA.eza_LetzteBearbeitung_SB = DY_ANM.dy_LetzteBearbeitung_SB
DAKOSY_Interface_SEND.loadInClass_VersandanmeldungEZA(EZA, Me, DY_ANM)
If Not EZA.SAVE_ALL() Then
'gespeichert
End If
End If
DY_ANM.UPDATE_DATA()
End Sub
Private Sub NeueBezugsnummerVergebenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles NeueBezugsnummerVergebenToolStripMenuItem.Click
BezugsNr = getBezugsnr(BezugsNr)
End Sub
Private Sub EZAIDToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles EZAIDToolStripMenuItem.Click
If EZA IsNot Nothing Then
MsgBox(EZA.eza_Id)
End If
End Sub
Private Sub BezugsnummerKopierenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BezugsnummerKopierenToolStripMenuItem.Click
Clipboard.SetText(lblBezugsnummer.Text)
End Sub
Private Sub DynamicAutomotiveXLSToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DynamicAutomotiveXLSToolStripMenuItem.Click
importExcel_DynamicAutomotive()
End Sub
Private Function checkExcel_DynamicAutomotive(Blatt As Excel.Worksheet) As Boolean
'Prüfung
Try
If Blatt Is Nothing Then Return False
If Blatt.Range("B23") Is Nothing Then Return False
If Blatt.Range("B23").Value.ToString <> "Code" Then Return False
Catch ex As Exception
MsgBox("Fehler bei der Prüfung!" & ex.Message)
Me.Cursor = Cursors.Default
Return False
End Try
Return True
End Function
Private Function checkExcel_Geze(Blatt As Excel.Worksheet) As Boolean
'Prüfung
Try
If Blatt Is Nothing Then Return False
If Blatt.Range("I1") Is Nothing Then Return False
If Blatt.Range("I1").Value.ToString <> "Codenummer" Then Return False
Catch ex As Exception
MsgBox("Fehler bei der Prüfung!" & ex.Message)
Me.Cursor = Cursors.Default
Return False
End Try
Return True
End Function
Private Function checkExcel_MEYLE(Blatt As Excel.Worksheet) As Boolean
'Prüfung
Try
If Blatt Is Nothing Then Return False
If Blatt.Range("A3") Is Nothing Then Return False
If Blatt.Range("A3").Value.ToString <> "Eingangsrechnung Lieferant:" Then Return False
Catch ex As Exception
MsgBox("Fehler bei der Prüfung!" & ex.Message)
Me.Cursor = Cursors.Default
Return False
End Try
Return True
End Function
Private Function importExcel_DynamicAutomotive() As Boolean
Dim fd As New OpenFileDialog
fd.Filter = "Excel Dateien|*.xls;*.xlsx"
Dim result As DialogResult = fd.ShowDialog()
If Not fd.FileName.EndsWith(".xls") And Not fd.FileName.EndsWith(".xlsx") Then
Me.Cursor = Cursors.Default
Return False
End If
If result = System.Windows.Forms.DialogResult.OK Then
Me.Cursor = Cursors.WaitCursor
Dim exclApp As New Excel.Application 'Object 'as Application
Dim Datei As Excel.Workbook ' 'as WorkBook
Dim Blatt As Excel.Worksheet 'Object 'as WorkSheet
With exclApp
Try
.CutCopyMode = False
.DisplayAlerts = False
Datei = .Workbooks.Open(fd.FileName)
Blatt = Datei.Worksheets(1)
Datei.Activate()
Try
Blatt.ShowAllData() 'Falls Filter ausgewählt wurde
Catch ex As Exception
End Try
Dim startFound As Boolean = False
Dim endFound As Boolean = False
If Not checkExcel_DynamicAutomotive(Blatt) Then 'VALIDIERUNG
Me.Cursor = Cursors.Default
Return False
End If
If EZA.eza_WARENPOS.Count > 0 Then
If vbYes = MsgBox("Sollten die aktuellen Einträge gelöscht werden?", vbYesNo) Then
EZA.eza_WARENPOS.Clear() 'Zurücksetzen
End If
End If
Dim startRows As Integer = 24
Dim endRows As Integer = startRows
While endRows < Blatt.UsedRange.Rows.Count
If Not Blatt.Range("B" & endRows) Is Nothing AndAlso Not Blatt.Range("B" & endRows).Value Is Nothing AndAlso Not Blatt.Range("B" & endRows).Value.ToString.Trim = "" Then
endFound = True
Else
Exit While
End If
endRows += 1
End While
endRows -= 1
If Not endFound Then
MsgBox("Keine Daten vorhanden!")
Me.Cursor = Cursors.Default
Return False
End If
'Laden des Bereiches aus dem Excel:
Dim myRange As Excel.Range
myRange = Blatt.Range("B" & startRows & ":I" & endRows & "")
Dim myArray As Object(,) '<-- declared as 2D Array
myArray = myRange.Value 'store the content of each cell
'myArray(i_soll2 - startRows + 1, 4)
Dim cnt = 0
Try
For i As Integer = 1 To endRows - startRows + 1 Step 1
Dim POSITION As New DAKOSY_Worker.cDakosy_EZA_Warenposition
POSITION.ezaWP_WarennummerEZT = myArray(i, 5).ToString()
POSITION.ezaWP_PackstueckAnzahl = myArray(i, 6).ToString()
POSITION.ezaWP_PackstueckArt = "PK"
POSITION.ezaWP_Artikelpreis = CDbl(myArray(i, 8).ToString()).ToString("N2")
POSITION.ezaWP_ArtikelpreisWaehrung = "EUR"
POSITION.ezaWP_Warenbezeichnung = myArray(i, 2).ToString()
Select Case myArray(i, 4).ToString
Case "TURKEY" : POSITION.ezaWP_UrsprungslandCode = "TR"
Case "ITALY" : POSITION.ezaWP_UrsprungslandCode = "IT"
Case "SPAIN" : POSITION.ezaWP_UrsprungslandCode = "ES"
Case "GERMANY" : POSITION.ezaWP_UrsprungslandCode = "DE"
Case "CZECH REPUBLIC" : POSITION.ezaWP_UrsprungslandCode = "CZ"
Case "FRANCE" : POSITION.ezaWP_UrsprungslandCode = "FR"
End Select
EZA.eza_WARENPOS.Add(POSITION)
cnt += 1
Next
Catch ex As Exception
MsgBox("Fehler beim Einlesen der Excel-Datei!" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
Me.Cursor = Cursors.Default
Return False
End Try
.Visible = False
' AddHandler exclApp.WorkbookBeforeClose, AddressOf BeforeBookClose
'Excelobjekte freistellten
' For Each obj In New Object() {exclApp, Datei, Datei, Blatt, Blatt}
' System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj)
' Next
Datei.Close()
Me.FindForm.SuspendLayout()
POSITIONEN.setValues(EZA, True)
btnPositionen.PerformClick()
MsgBox(cnt & " Datensätze wurden eingelesen. ")
Me.FindForm.ResumeLayout()
Me.Cursor = Cursors.Default
Return True
Catch ex As Exception
'
Me.Cursor = Cursors.Default
MsgBox("FEHLER! Datei im richtigen Format?" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
' Return False
End Try
End With
Return True
Else
MsgBox("Keine Datei ausgewählt!")
End If
Me.Cursor = Cursors.Default
Return False
End Function
Private Function importExcel_Geze() As Boolean
Dim fd As New OpenFileDialog
fd.Filter = "Excel Dateien|*.xls;*.xlsx"
Dim result As DialogResult = fd.ShowDialog()
If Not fd.FileName.ToLower.EndsWith(".xls") And Not fd.FileName.ToLower.EndsWith(".xlsx") Then
Me.Cursor = Cursors.Default
Return False
End If
If result = System.Windows.Forms.DialogResult.OK Then
Me.Cursor = Cursors.WaitCursor
Dim exclApp As New Excel.Application 'Object 'as Application
Dim Datei As Excel.Workbook ' 'as WorkBook
Dim Blatt As Excel.Worksheet 'Object 'as WorkSheet
With exclApp
Try
.CutCopyMode = False
.DisplayAlerts = False
Datei = .Workbooks.Open(fd.FileName)
Blatt = Datei.Worksheets(1)
Datei.Activate()
Try
Blatt.ShowAllData() 'Falls Filter ausgewählt wurde
Catch ex As Exception
End Try
Dim startFound As Boolean = False
Dim endFound As Boolean = False
If Not checkExcel_Geze(Blatt) Then 'VALIDIERUNG
Me.Cursor = Cursors.Default
Return False
End If
If EZA.eza_WARENPOS.Count > 0 Then
If vbYes = MsgBox("Sollten die aktuellen Einträge gelöscht werden?", vbYesNo) Then
EZA.eza_WARENPOS.Clear() 'Zurücksetzen
End If
End If
Dim startRows As Integer = 2
Dim endRows As Integer = startRows
While endRows < Blatt.UsedRange.Rows.Count
If Not Blatt.Range("I" & endRows) Is Nothing AndAlso Not Blatt.Range("I" & endRows).Value Is Nothing AndAlso Not Blatt.Range("I" & endRows).Value.ToString.Trim = "" Then
endFound = True
Else
Exit While
End If
endRows += 1
End While
' endRows -= 1
If Not endFound Then
MsgBox("Keine Daten vorhanden!")
Me.Cursor = Cursors.Default
Return False
End If
'Laden des Bereiches aus dem Excel:
Dim myRange As Excel.Range
myRange = Blatt.Range("A" & startRows & ":I" & endRows & "")
Dim myArray As Object(,) '<-- declared as 2D Array
myArray = myRange.Value 'store the content of each cell
'myArray(i_soll2 - startRows + 1, 4)
'For i As Integer = 1 To myArray.GetLength(0)
' For j As Integer = 1 To myArray.GetLength(1)
' Console.Write(myArray(i, j).ToString() & vbTab)
' Next
' Console.WriteLine()
'Next
Dim cnt = 0
Try
For i As Integer = 1 To endRows - startRows + 1 Step 1
If myArray(i, 1) IsNot Nothing AndAlso myArray(i, 1).ToString() <> "" Then
Dim POSITION As New DAKOSY_Worker.cDakosy_EZA_Warenposition
POSITION.ezaWP_WarennummerEZT = myArray(i, 9).ToString()
POSITION.ezaWP_PackstueckAnzahl = "0" 'myArray(i, 6).ToString()
POSITION.ezaWP_PackstueckArt = "PK"
POSITION.ezaWP_Artikelpreis = CDbl(myArray(i, 7).ToString()).ToString("N2")
POSITION.ezaWP_ArtikelpreisWaehrung = myArray(i, 8).ToString()
POSITION.ezaWP_Warenbezeichnung = myArray(i, 4).ToString()
'Select Case myArray(i, 4).ToString
' Case "TURKEY" : POSITION.ezaWP_UrsprungslandCode = "TR"
' Case "ITALY" : POSITION.ezaWP_UrsprungslandCode = "IT"
' Case "SPAIN" : POSITION.ezaWP_UrsprungslandCode = "ES"
' Case "GERMANY" : POSITION.ezaWP_UrsprungslandCode = "DE"
' Case "CZECH REPUBLIC" : POSITION.ezaWP_UrsprungslandCode = "CZ"
' Case "FRANCE" : POSITION.ezaWP_UrsprungslandCode = "FR"
POSITION.ezaWP_PositionsZusatz = "ArtikelNr: " & myArray(i, 1).ToString()
POSITION.ezaWP_Artikelnummer = myArray(i, 1).ToString()
'End Select
POSITION.ezaWP_UNTERLAGEN.Add(New DAKOSY_Worker.cDakosy_EZA_WarenpositionVorgelegteUnterlagen With {
.ezaWpUl_Art = "N380",
.ezaWpUl_Bereich = "4",
.ezaWpUl_VorlageKz = "J",
.ezaWpUl_Nummer = myArray(i, 2).ToString(),
.ezaWpUl_DatumAusstellung = Nothing
})
EZA.eza_WARENPOS.Add(POSITION)
cnt += 1
End If
Next
Catch ex As Exception
MsgBox("Fehler beim Einlesen der Excel-Datei!" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
Me.Cursor = Cursors.Default
Return False
End Try
.Visible = False
' AddHandler exclApp.WorkbookBeforeClose, AddressOf BeforeBookClose
'Excelobjekte freistellten
' For Each obj In New Object() {exclApp, Datei, Datei, Blatt, Blatt}
' System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj)
' Next
Datei.Close()
Me.FindForm.SuspendLayout()
POSITIONEN.setValues(EZA, True)
btnPositionen.PerformClick()
MsgBox(cnt & " Datensätze wurden eingelesen. ")
Me.FindForm.ResumeLayout()
Me.Cursor = Cursors.Default
Return True
Catch ex As Exception
'
Me.Cursor = Cursors.Default
MsgBox("FEHLER! Datei im richtigen Format?" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
' Return False
End Try
End With
Return True
Else
MsgBox("Keine Datei ausgewählt!")
End If
Me.Cursor = Cursors.Default
Return False
End Function
Private Function importExcel_MEYLE() As Boolean
Dim f As New frmImportFromAVISOAnhaenge(AVISO, SENDUNG)
f.ShowDialog(Me)
Dim LIST_FILES = f.LIST_FILES
If Not f.DialogResult = DialogResult.OK Then Return False
If LIST_FILES.Count = 0 Then Return False
Dim cnt = 0
If EZA.eza_WARENPOS.Count > 0 Then
If vbYes = MsgBox("Sollten die aktuellen Einträge gelöscht werden?", vbYesNo) Then
EZA.eza_WARENPOS.Clear() 'Zurücksetzen
End If
End If
Me.Cursor = Cursors.WaitCursor
For Each filePath As String In LIST_FILES
If Not filePath.ToLower.EndsWith(".xls") AndAlso Not filePath.ToLower.EndsWith(".xlsx") Then
' Ungültige Datei überspringen oder abbrechen
Continue For
End If
Dim exclApp As New Excel.Application 'Object 'as Application
Dim Datei As Excel.Workbook ' 'as WorkBook
Dim Blatt As Excel.Worksheet 'Object 'as WorkSheet
With exclApp
Try
.CutCopyMode = False
.DisplayAlerts = False
Datei = .Workbooks.Open(filePath)
Blatt = Datei.Worksheets(1)
Datei.Activate()
Try
Blatt.ShowAllData() 'Falls Filter ausgewählt wurde
Catch ex As Exception
End Try
Dim startFound As Boolean = False
Dim endFound As Boolean = False
If Not checkExcel_MEYLE(Blatt) Then 'VALIDIERUNG
Me.Cursor = Cursors.Default
Return False
End If
Dim startRows As Integer = 6
Dim endRows As Integer = startRows
While endRows < Blatt.UsedRange.Rows.Count
If Not Blatt.Range("A" & endRows) Is Nothing AndAlso Not Blatt.Range("A" & endRows).Value Is Nothing AndAlso Not Blatt.Range("A" & endRows).Value.ToString.Trim = "" Then
endFound = True
Else
Exit While
End If
endRows += 1
End While
endRows -= 1
If Not endFound Then
MsgBox("Keine Daten vorhanden!")
Me.Cursor = Cursors.Default
Return False
End If
' Neue DataTable erstellen
Dim DATA As New DataTable()
' Spalten anhand der Anzahl im Range anlegen
Dim colCount As Integer = Blatt.Range("A1:M1").Columns.Count
For c As Integer = 1 To colCount
DATA.Columns.Add("Spalte" & c, GetType(String))
Next
' Range direkt durchlaufen
For r As Integer = startRows To endRows
Dim newRow As DataRow = DATA.NewRow()
For c As Integer = 1 To colCount
Dim value = Blatt.Cells(r, c).Value
newRow(c - 1) = If(value IsNot Nothing, value.ToString(), "")
Next
DATA.Rows.Add(newRow)
Next
' DataTable durchlaufen und Zeilen löschen, bei denen Spalte 6 "summe" enthält
For i As Integer = DATA.Rows.Count - 1 To 0 Step -1
Dim cellValue As String = DATA.Rows(i)(6).ToString().ToLower() ' Spalte 6 = Index 5
If cellValue.Contains("summe") Then
DATA.Rows.RemoveAt(i)
End If
Next
'--------------------------------------------------------------------------------------------------------------
' Spaltenüberschriften ausgeben
For Each col As DataColumn In DATA.Columns
Console.Write(col.ColumnName & vbTab)
Next
Console.WriteLine()
' Alle Zeilen ausgeben
For Each row As DataRow In DATA.Rows
For Each col As DataColumn In DATA.Columns
Console.Write(row(col).ToString() & vbTab)
Next
Console.WriteLine()
Next
'--------------------------------------------------------------------------------------------------------------
'-------------HIER WERDEN DIE Zeilen kommuliert---------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------
' Neue Tabelle mit gleicher Struktur
Dim resultDATA As DataTable = DATA.Clone()
'0 = Wartentarifnummer
'6 = Wartenbeschreibung
'12 = Währung (immer gleich)?
' Gruppieren nach den Schlüsseln Spalte 0, 6 und 12
Dim groups = From row In DATA.AsEnumerable()
Group row By key1 = row(0), key2 = row(6), key3 = row(12) Into grp = Group
Select key1, key2, key3, grp
' Gruppen durchlaufen und kumulierte Zeilen erstellen
For Each g In groups
Dim newRow As DataRow = resultDATA.NewRow()
' Gruppierungsspalten setzen
newRow(0) = g.key1
newRow(6) = g.key2
newRow(12) = g.key3
' Summen berechnen
newRow(7) = g.grp.Sum(Function(r) ToDoubleSafe(r(7)))
newRow(9) = g.grp.Sum(Function(r) ToDoubleSafe(r(9)))
newRow(11) = g.grp.Sum(Function(r) ToDoubleSafe(r(11)))
' Restliche Spalten Nothing lassen (bleibt automatisch so)
resultDATA.Rows.Add(newRow)
Next
' Falls du das Ergebnis in DATA zurückschreiben willst:
DATA = resultDATA
'--------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------
' Spaltenüberschriften ausgeben
For Each col As DataColumn In DATA.Columns
Console.Write(col.ColumnName & vbTab)
Next
Console.WriteLine()
' Alle Zeilen ausgeben
For Each row As DataRow In DATA.Rows
For Each col As DataColumn In DATA.Columns
Console.Write(row(col).ToString() & vbTab)
Next
Console.WriteLine()
Next
'--------------------------------------------------------------------------------------------------------------
Dim HandlesRgNr = ""
If Blatt.Range("B3") IsNot Nothing AndAlso Blatt.Range("B3").Value IsNot Nothing Then
HandlesRgNr = Blatt.Range("B3").Value.ToString().Trim()
End If
Dim HandlesRgDat = ""
If Blatt.Range("B1") IsNot Nothing AndAlso Blatt.Range("B1").Value IsNot Nothing Then
HandlesRgDat = Blatt.Range("B1").Value.ToString().Trim()
End If
' MsgBox("A" & startRows & ":I" & endRows & "")
Try
For Each row As DataRow In DATA.Rows
' Prüfen, ob Spalte 1 (Index 0) gefüllt ist
If row(0) IsNot Nothing AndAlso row(0).ToString().Trim() <> "" Then
Dim POSITION As New DAKOSY_Worker.cDakosy_EZA_Warenposition
POSITION.ezaWP_WarennummerEZT = row(0).ToString()
POSITION.ezaWP_PackstueckAnzahl = "0" ' row(5).ToString()
POSITION.ezaWP_PackstueckArt = "PK"
' Sicher konvertieren, falls leer oder ungültig
Dim preis As Double
Double.TryParse(row(11).ToString(), preis)
POSITION.ezaWP_Artikelpreis = preis.ToString("N2")
POSITION.ezaWP_ArtikelpreisWaehrung = row(12).ToString()
POSITION.ezaWP_Warenbezeichnung = row(6).ToString()
Dim masse As Double
Double.TryParse(row(9).ToString(), masse)
POSITION.ezaWP_Eigenmasse = masse.ToString("N1")
' Ursprungsland ggf. per Select Case setzen
'Select Case row(3).ToString()
' Case "TURKEY" : POSITION.ezaWP_UrsprungslandCode = "TR"
' Case "ITALY" : POSITION.ezaWP_UrsprungslandCode = "IT"
' ...
'End Select
POSITION.ezaWP_UNTERLAGEN.Add(New DAKOSY_Worker.cDakosy_EZA_WarenpositionVorgelegteUnterlagen With {
.ezaWpUl_Art = "N380",
.ezaWpUl_Bereich = "4",
.ezaWpUl_VorlageKz = "J",
.ezaWpUl_Nummer = HandlesRgNr,
.ezaWpUl_DatumAusstellung = Nothing
})
EZA.eza_WARENPOS.Add(POSITION)
cnt += 1
End If
Next
Catch ex As Exception
MsgBox("Fehler beim Einlesen der Excel-Datei!" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
Me.Cursor = Cursors.Default
Return False
End Try
.Visible = False
' AddHandler exclApp.WorkbookBeforeClose, AddressOf BeforeBookClose
'Excelobjekte freistellten
' For Each obj In New Object() {exclApp, Datei, Datei, Blatt, Blatt}
' System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj)
' Next
Datei.Close()
Catch ex As Exception
'
Me.Cursor = Cursors.Default
MsgBox("FEHLER! Datei im richtigen Format?" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
' Return False
End Try
End With
' >>> Hier kannst du jede gültige Excel-Datei weiterverarbeiten:
Console.WriteLine("Verarbeite Datei: " & filePath)
' z.B. Excel öffnen, Range lesen etc.
Next
Me.FindForm.SuspendLayout()
POSITIONEN.setValues(EZA, True)
btnPositionen.PerformClick()
Me.FindForm.ResumeLayout()
MsgBox(cnt & " Datensätze wurden eingelesen. ")
Me.Cursor = Cursors.Default
Return True
Me.Cursor = Cursors.Default
Return False
End Function
Private Sub pnl_Paint_1(sender As Object, e As PaintEventArgs) Handles pnl.Paint
End Sub
Private Sub XMLExampleToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles XMLExampleToolStripMenuItem.Click
Me.Refresh()
cboDakosyAction.Focus() 'nur, damit alle _value aktualisuiert sind...
' Dim cDyAnm As New cDakosy_Zollanmeldungen(cDy_ART, BezugsNr, AVISO.AvisoID, SENDUNG.tblSnd_SendungID)
loadDYZollanmeldungen()
If DY_ANM Is Nothing Then
DY_ANM = New cDakosy_Zollanmeldungen(EZA.eza_dyaAnmID)
End If
DY_ANM.dy_ART = ALLG.EZA_ART 'cDy_ART
DY_ANM.dy_BezugsNr = BezugsNr
If EZA IsNot Nothing Then
'Dim cDY As New cDakosyEZA(cDyAnm.dy_Id, cDyAnm.dy_Erstellung_SB)
EZA.eza_dyaAnmID = DY_ANM.dy_Id
EZA.eza_Erstellung_SB = DY_ANM.dy_Erstellung_SB
EZA.eza_LetzteBearbeitung = Now
EZA.eza_LetzteBearbeitung_SB = DY_ANM.dy_LetzteBearbeitung_SB
EZA.eza_firma = Me.FIRMA_DY
DAKOSY_Interface_SEND.loadInClass_VersandanmeldungEZA(EZA, Me, DY_ANM)
' If Not EZA.SAVE_ALL() Then Exit Sub
Dim tempFilePath As String = System.IO.Path.GetTempFileName()
' Ändere die Endung in .xml
Dim saveFile As String = System.IO.Path.ChangeExtension(tempFilePath, ".xml")
If DAKOSY_Interface_SEND.generateVersandanmeldungEZA(EZA, saveFile, cboDakosyAction._value) Then
If saveFile <> "" Then
Process.Start(saveFile)
End If
End If
End If
End Sub
Private Sub GEZEXLSXToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles GEZEXLSXToolStripMenuItem.Click
importExcel_Geze()
End Sub
Private Sub MEYLEXLSXToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles MEYLEXLSXToolStripMenuItem.Click
importExcel_MEYLE()
End Sub
Private Sub FressnapToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles FressnapToolStripMenuItem.Click
importExcel_Fressnapf()
End Sub
Private Function importExcel_Fressnapf() As Boolean
Dim f As New frmImportFromAVISOAnhaenge(AVISO, SENDUNG)
f.ShowDialog(Me)
Dim LIST_FILES = f.LIST_FILES
If Not f.DialogResult = DialogResult.OK Then Return False
If LIST_FILES.Count = 0 Then Return False
Dim cnt As Integer = 0
If EZA.eza_WARENPOS.Count > 0 Then
If vbYes = MsgBox("Sollten die aktuellen Einträge gelöscht werden?", vbYesNo) Then
EZA.eza_WARENPOS.Clear()
End If
End If
Me.Cursor = Cursors.WaitCursor
For Each filePath As String In LIST_FILES
If Not (filePath.ToLower().EndsWith(".xls") OrElse filePath.ToLower().EndsWith(".xlsx")) Then
Continue For
End If
Dim exclApp As Excel.Application = Nothing
Dim Datei As Excel.Workbook = Nothing
Dim Blatt As Excel.Worksheet = Nothing
Try
exclApp = New Excel.Application With {
.CutCopyMode = False,
.DisplayAlerts = False
}
Datei = exclApp.Workbooks.Open(filePath)
Blatt = CType(Datei.Worksheets(1), Excel.Worksheet)
Datei.Activate()
Try : Blatt.ShowAllData() : Catch : End Try
' --- Prüfe, ob Kopfzeile in Zeile 17 existiert
If Not checkExcelHeader_Fressnapf(Blatt) Then
Throw New ApplicationException("Excel-Struktur entspricht nicht dem erwarteten Layout (Header-Zeile 17).")
End If
' --- Spalten dynamisch per Header ermitteln (Zeile 17)
Dim colDesc = FindHeaderColumn(Blatt, 17, {"warenbeschreibung"})
Dim colImpCode = FindHeaderColumn(Blatt, 17, {"importcodenummer", "warentarifnummer", "eztnummer", "ezt-nummer"})
Dim colOrigin = FindHeaderColumn(Blatt, 17, {"ursprungsland", "ursprungslandcode"})
Dim colCurrency = FindHeaderColumn(Blatt, 17, {"währung", "waehrung", "currency"})
Dim colNetMass = FindHeaderColumn(Blatt, 17, {"nettomasse", "nettomas­se", "nettomasse kg", "eigenmasse"})
Dim colQty = FindHeaderColumn(Blatt, 17, {"menge", "quantity", "qty"})
Dim colValue = FindHeaderColumn(Blatt, 17, {"warenwert", "invoice value", "value"})
' Minimal erforderliche Spalten prüfen
If colDesc = -1 OrElse colImpCode = -1 OrElse colOrigin = -1 OrElse colCurrency = -1 OrElse colValue = -1 Then
Throw New ApplicationException("Nicht alle erforderlichen Spaltenköpfe gefunden (Beschreibung/Warentarifnummer/Ursprungsland/Währung/Warenwert).")
End If
' --- Datenbereich bestimmen: ab Zeile 18 bis erste Leerzeile in Spalte A (Pos.)
Dim startRows As Integer = 18
Dim endRows As Integer = startRows
Dim usedRows As Integer = Blatt.UsedRange.Rows.Count
Do While endRows <= usedRows
Dim val = Blatt.Range("A" & endRows).Value
If val Is Nothing OrElse val.ToString().Trim() = "" Then Exit Do
endRows += 1
Loop
endRows -= 1
If endRows < startRows Then
Throw New ApplicationException("Keine Positionsdaten im Excel gefunden.")
End If
' --- Spaltenanzahl mindestens so groß wie letzte genutzte Spalte
Dim colCount As Integer = Math.Max(Blatt.UsedRange.Columns.Count, Math.Max(Math.Max(Math.Max(colDesc, colImpCode), Math.Max(colOrigin, colCurrency)), Math.Max(colValue, If(colNetMass < 0, 0, colNetMass))) + 1)
If colCount < 19 Then colCount = 19 ' typischerweise A..S
' --- Rohdaten in DataTable übernehmen
Dim DATA As New DataTable()
For c As Integer = 1 To colCount
DATA.Columns.Add("Spalte" & c, GetType(String))
Next
For r As Integer = startRows To endRows
Dim newRow As DataRow = DATA.NewRow()
For c As Integer = 1 To colCount
Dim value = Blatt.Cells(r, c).Value
newRow(c - 1) = If(value IsNot Nothing, value.ToString(), "")
Next
' Normalisierung für Gruppierung
If colCurrency >= 0 Then newRow(colCurrency) = newRow(colCurrency).ToString().Trim().ToUpper()
If colOrigin >= 0 Then newRow(colOrigin) = newRow(colOrigin).ToString().Trim().ToUpper()
DATA.Rows.Add(newRow)
Next
' --- Nur numerische Pos.-Zeilen behalten (Spalte A / Index 0)
For i As Integer = DATA.Rows.Count - 1 To 0 Step -1
Dim posTxt As String = DATA.Rows(i)(0).ToString().Trim()
Dim posNum As Integer
If Not Integer.TryParse(posTxt, posNum) Then
DATA.Rows.RemoveAt(i)
End If
Next
' --- Gruppieren nach: Beschreibung, Warentarifnummer, Ursprungsland, Währung
Dim resultDATA As DataTable = DATA.Clone()
Dim groups = From row In DATA.AsEnumerable()
Group row By
keyDesc = row(colDesc),
keyTariff = row(colImpCode),
keyOrigin = row(colOrigin),
keyCurr = row(colCurrency)
Into grp = Group
Select keyDesc, keyTariff, keyOrigin, keyCurr, grp
For Each g In groups
Dim newRow As DataRow = resultDATA.NewRow()
newRow(colDesc) = g.keyDesc
newRow(colImpCode) = g.keyTariff
newRow(colOrigin) = g.keyOrigin
newRow(colCurrency) = g.keyCurr
' Summenfelder (nur wenn vorhanden)
If colQty >= 0 Then newRow(colQty) = g.grp.Sum(Function(r) ToDoubleSafe(r(colQty))).ToString()
If colNetMass >= 0 Then newRow(colNetMass) = g.grp.Sum(Function(r) ToDoubleSafe(r(colNetMass))).ToString()
newRow(colValue) = g.grp.Sum(Function(r) ToDoubleSafe(r(colValue))).ToString()
resultDATA.Rows.Add(newRow)
Next
' --- Kopfwerte optional (z. B. Belegnummer)
Dim HandlesRgNr As String = ""
Try
If Blatt.Range("A8") IsNot Nothing AndAlso Blatt.Range("A8").Value IsNot Nothing Then
HandlesRgNr = Blatt.Range("A8").Value.ToString().Trim()
End If
Catch
End Try
' --- Ergebniszeilen in EZA schreiben
For Each row As DataRow In resultDATA.Rows
Dim tariff As String = row(colImpCode).ToString().Trim()
Dim desc As String = row(colDesc).ToString().Trim()
If tariff = "" AndAlso desc = "" Then Continue For
Dim POSITION As New DAKOSY_Worker.cDakosy_EZA_Warenposition
' *** WAREN­TARIFNUMMER ***
POSITION.ezaWP_WarennummerEZT = tariff
' Packstücke (nicht aus Excel, Standardwerte)
POSITION.ezaWP_PackstueckAnzahl = "0"
POSITION.ezaWP_PackstueckArt = "PK"
' *** ARTIKELPREIS (Warenwert) ***
Dim warenwert As Double = ToDoubleSafe(row(colValue))
POSITION.ezaWP_Artikelpreis = warenwert.ToString("N2")
' *** WÄHRUNG ***
POSITION.ezaWP_ArtikelpreisWaehrung = row(colCurrency).ToString()
' *** BESCHREIBUNG ***
POSITION.ezaWP_Warenbezeichnung = desc
' *** EIGENMASSE (aus Nettomasse, wenn vorhanden) ***
If colNetMass >= 0 Then
Dim netto As Double = ToDoubleSafe(row(colNetMass))
POSITION.ezaWP_Eigenmasse = netto.ToString("N1")
Else
POSITION.ezaWP_Eigenmasse = "0.0"
End If
' *** URSPRUNGS­LAND (2-stellig) ***
Dim ursprung As String = row(colOrigin).ToString().Trim().ToUpper()
If ursprung.Length >= 2 Then POSITION.ezaWP_UrsprungslandCode = ursprung.Substring(0, 2)
' Unterlagen (optional)
If Not String.IsNullOrWhiteSpace(HandlesRgNr) Then
POSITION.ezaWP_UNTERLAGEN.Add(New DAKOSY_Worker.cDakosy_EZA_WarenpositionVorgelegteUnterlagen With {
.ezaWpUl_Art = "N380",
.ezaWpUl_Bereich = "4",
.ezaWpUl_VorlageKz = "J",
.ezaWpUl_Nummer = HandlesRgNr,
.ezaWpUl_DatumAusstellung = Nothing
})
End If
EZA.eza_WARENPOS.Add(POSITION)
cnt += 1
Next
Catch ex As Exception
Me.Cursor = Cursors.Default
MsgBox("FEHLER beim Einlesen: " & vbCrLf & ex.Message)
Finally
' Ressourcen sauber freigeben
Try
If Datei IsNot Nothing Then Datei.Close(False)
Catch
End Try
Try
If exclApp IsNot Nothing Then exclApp.Quit()
Catch
End Try
Try
If Blatt IsNot Nothing Then System.Runtime.InteropServices.Marshal.FinalReleaseComObject(Blatt)
Catch
End Try
Try
If Datei IsNot Nothing Then System.Runtime.InteropServices.Marshal.FinalReleaseComObject(Datei)
Catch
End Try
Try
If exclApp IsNot Nothing Then System.Runtime.InteropServices.Marshal.FinalReleaseComObject(exclApp)
Catch
End Try
Blatt = Nothing : Datei = Nothing : exclApp = Nothing
GC.Collect()
GC.WaitForPendingFinalizers()
End Try
Console.WriteLine("Verarbeite Datei: " & filePath)
Next
Me.FindForm.SuspendLayout()
POSITIONEN.setValues(EZA, True)
btnPositionen.PerformClick()
Me.FindForm.ResumeLayout()
MsgBox(cnt & " Datensätze wurden eingelesen.")
Me.Cursor = Cursors.Default
Return True
End Function
' Liefert die 0-basierte Spaltennummer (DataTable-Index) anhand eines Header-Texts in rowIdx.
' Gibt -1 zurück, wenn keine der gesuchten Varianten gefunden wird.
Private Function FindHeaderColumn(ws As Excel.Worksheet, rowIdx As Integer, headerVariants As IEnumerable(Of String)) As Integer
Dim maxScanCols As Integer = 35 ' etwas Puffer
For c As Integer = 1 To maxScanCols
Dim cell = ws.Cells(rowIdx, c).Value
If cell Is Nothing Then Continue For
Dim norm = cell.ToString().Trim().ToLower()
For Each hv In headerVariants
If norm.Contains(hv.ToLower()) Then
Return c - 1 ' DataTable ist 0-basiert
End If
Next
Next
Return -1
End Function
Private Function ToDoubleSafe(obj As Object) As Double
If obj Is Nothing Then Return 0
Dim s As String = obj.ToString().Trim()
If s = "" Then Return 0
' Komma/Punkt robust behandeln, kulturinvariant parsen
Dim d As Double
' Erst alle Tausenderpunkte/Kommas vereinheitlichen
s = s.Replace(" ", "")
' Häufigster Fall: deutsches Komma
If s.Contains(",") AndAlso Not s.Contains(".") Then
s = s.Replace(".", "")
s = s.Replace(",", ".")
ElseIf s.Contains(".") AndAlso s.Contains(",") Then
' Entferne Tausender-Trenner, behalte Dezimaltrennzeichen als Punkt
s = s.Replace(".", "")
s = s.Replace(",", ".")
End If
If Double.TryParse(s, Globalization.NumberStyles.Any, Globalization.CultureInfo.InvariantCulture, d) Then
Return d
End If
Return 0
End Function
' Prüft Kopfzeile in Zeile 17:
' A17="Pos.", D17 beginnt mit "Warenbeschreibung",
' P17 beginnt mit "Importcodenummer", R17 beginnt mit "Ursprungsland"
Private Function checkExcelHeader_Fressnapf(ws As Excel.Worksheet) As Boolean
Try
Dim a = CStr(ws.Range("A17").Value)
Dim d = CStr(ws.Range("D17").Value)
If a Is Nothing OrElse d Is Nothing Then Return False
Return a.Trim().ToLower() = "pos." AndAlso
d.Trim().ToLower().StartsWith("warenbeschreibung")
Catch
Return False
End Try
End Function
Private Sub VERAGIMPORTFormatToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles VERAGIMPORTFormatToolStripMenuItem.Click
ImportExcel_CustomsTemplate_V1()
End Sub
'================================================================================================================================
'================================================================================================================================
'================================================================================================================================
Public Function ImportExcel_CustomsTemplate_V1() As Boolean
' --- Dateiauswahl wie gehabt ---
Dim f As New frmImportFromAVISOAnhaenge(AVISO, SENDUNG)
f.ShowDialog(Me)
If f.DialogResult <> DialogResult.OK Then Return False
If f.LIST_FILES Is Nothing OrElse f.LIST_FILES.Count = 0 Then Return False
' --- ggf. vorhandene Positionen leeren ---
If EZA.eza_WARENPOS.Count > 0 Then
If vbYes = MsgBox("Sollen vorhandene Positionen gelöscht werden?", vbYesNo) Then
EZA.eza_WARENPOS.Clear()
End If
End If
Me.Cursor = Cursors.WaitCursor
Dim cnt As Integer = 0
For Each filePath As String In f.LIST_FILES
If Not (filePath.EndsWith(".xlsx", StringComparison.OrdinalIgnoreCase) OrElse filePath.EndsWith(".xls", StringComparison.OrdinalIgnoreCase)) Then
Continue For
End If
Dim xlApp As Excel.Application = Nothing
Dim wb As Excel.Workbook = Nothing
Dim ws As Excel.Worksheet = Nothing
Try
xlApp = New Excel.Application()
xlApp.DisplayAlerts = False
xlApp.CutCopyMode = False
wb = xlApp.Workbooks.Open(filePath)
ws = CType(wb.Worksheets(1), Excel.Worksheet)
wb.Activate()
' Falls Autofilter aktiv: ShowAllData() versuchen (optional)
Try
ws.ShowAllData()
Catch
End Try
' ---------- VERSIONSPRÜFUNG ----------
Dim versionTag As String = GetCellStr(ws, 2, 8) ' H2
If Not String.Equals(versionTag, "2025-V1", StringComparison.OrdinalIgnoreCase) Then
Throw New ApplicationException("Version nicht unterstützt (gefunden: '" & versionTag & "', erwartet: '2025-V1').")
End If
' ---------- 1) HEADER KEY/VALUE (A/B) ----------
Dim header As New Dictionary(Of String, String)(StringComparer.OrdinalIgnoreCase)
Dim usedRows As Integer = ws.UsedRange.Rows.Count
Dim r As Integer
For r = 3 To Math.Min(80, usedRows + 5)
Dim k As String = GetCellStr(ws, r, 1)
Dim v As String = GetCellStr(ws, r, 2)
If Not String.IsNullOrWhiteSpace(k) Then header(k) = v
Next
' ein paar Kopfwerte ins EZA (alle optional)
Dim HandelsRgNr As String = ""
If header.ContainsKey("Invoice No.") Then HandelsRgNr = header("Invoice No.")
If header.ContainsKey("Currency") Then EZA.eza_Rechnungswaehrung = header("Currency")
If header.ContainsKey("Delivery Terms (Incoterms)") Then EZA.eza_LieferbedingungCode = header("Delivery Terms (Incoterms)")
If header.ContainsKey("Total Gross Weight (kg)") Then EZA.eza_GesamtRohmasse = ToDoubleSafeVERAGTmpl(header("Total Gross Weight (kg)"))
If header.ContainsKey("Truck Plate (Tractor)") Then EZA.eza_KennzeichenNameBefoerderungsmittelAnkunft = header("Truck Plate (Tractor)")
' ---------- 2) CONSIGNOR / CONSIGNEE ----------
Dim rowCons As Integer = -1
Dim rowCee As Integer = -1
For r = 3 To Math.Min(80, usedRows + 5)
Dim aVal As String = GetCellStr(ws, r, 1)
If rowCons < 0 AndAlso String.Equals(aVal, "Consignor / Exporter", StringComparison.OrdinalIgnoreCase) Then rowCons = r
If rowCee < 0 AndAlso String.Equals(aVal, "Consignee / Importer", StringComparison.OrdinalIgnoreCase) Then rowCee = r
If rowCons > 0 AndAlso rowCee > 0 Then Exit For
Next
' Kundennummern nur ermitteln, wenn die Blöcke auch existieren
Dim kdnrImp As String = If(rowCee > 0, GetCellStr(ws, rowCee + 1, 6), "")
Dim kdnrCons As String = If(rowCons > 0, GetCellStr(ws, rowCons + 1, 6), "")
If rowCons > 0 Then
'Prüfen, ob Adresse schon vorhanden:
If Not EZA.eza_ADRESSEN.Any(Function(a) a.ezaAd_AdressTyp IsNot Nothing AndAlso a.ezaAd_AdressTyp.ToString().ToUpper() = "CZ") Then
Dim rr As Integer = rowCons + 1
Dim adrC As New cDakosy_EZA_Adressen()
adrC.ezaAd_AdressTyp = "CZ"
If Not String.IsNullOrWhiteSpace(kdnrCons) Then
' --- Daten aus Datenbank (cAdressen) laden ---
Dim AD As New cAdressen(kdnrCons)
Dim KD As New cKunde(kdnrCons)
adrC.ezaAd_NameFirma1 = AD.Name_1
adrC.ezaAd_LandCode = cProgramFunctions.getISO2Land(AD.LandKz)
adrC.ezaAd_PLZ = AD.PLZ
adrC.ezaAd_Ort = AD.Ort
adrC.ezaAd_StrasseHausNr1 = AD.Straße
If Not String.IsNullOrWhiteSpace(KD.EORITIN) Then adrC.ezaAd_TeilnehmerEORI = KD.EORITIN
Else
' --- Excel-Werte (alle optional) ---
Dim consCompany As String = GetCellStr(ws, rr, 1)
Dim consCountry As String = GetCellStr(ws, rr, 2).ToUpperInvariant()
Dim consZIP As String = GetCellStr(ws, rr, 3)
Dim consCity As String = GetCellStr(ws, rr, 4)
Dim consStreet As String = GetCellStr(ws, rr, 5)
If consCompany <> "" Then adrC.ezaAd_NameFirma1 = consCompany
If consCountry <> "" Then adrC.ezaAd_LandCode = consCountry
If consZIP <> "" Then adrC.ezaAd_PLZ = consZIP
If consCity <> "" Then adrC.ezaAd_Ort = consCity
If consStreet <> "" Then adrC.ezaAd_StrasseHausNr1 = consStreet
End If
EZA.eza_ADRESSEN.Add(adrC)
End If
End If
If rowCee > 0 Then
'Prüfen, ob Adresse schon vorhanden:
If Not EZA.eza_ADRESSEN.Any(Function(a) a.ezaAd_AdressTyp IsNot Nothing AndAlso a.ezaAd_AdressTyp.ToString().ToUpper() = "CN") Then
Dim rr As Integer = rowCee + 1
Dim adrE As New cDakosy_EZA_Adressen()
adrE.ezaAd_AdressTyp = "CN"
If Not String.IsNullOrWhiteSpace(kdnrImp) Then
' --- Daten aus Datenbank (cAdressen) laden ---
Dim AD As New cAdressen(kdnrImp)
Dim KD As New cKunde(kdnrImp)
adrE.ezaAd_NameFirma1 = AD.Name_1
adrE.ezaAd_LandCode = cProgramFunctions.getISO2Land(AD.LandKz)
adrE.ezaAd_PLZ = AD.PLZ
adrE.ezaAd_Ort = AD.Ort
adrE.ezaAd_StrasseHausNr1 = AD.Straße
If Not String.IsNullOrWhiteSpace(KD.EORITIN) Then adrE.ezaAd_TeilnehmerEORI = KD.EORITIN
Else
' --- Excel-Werte (alle optional) ---
Dim ceeCompany As String = GetCellStr(ws, rr, 1)
Dim ceeCountry As String = GetCellStr(ws, rr, 2).ToUpperInvariant()
Dim ceeZIP As String = GetCellStr(ws, rr, 3)
Dim ceeCity As String = GetCellStr(ws, rr, 4)
Dim ceeStreet As String = GetCellStr(ws, rr, 5)
If ceeCompany <> "" Then adrE.ezaAd_NameFirma1 = ceeCompany
If ceeCountry <> "" Then adrE.ezaAd_LandCode = ceeCountry
If ceeZIP <> "" Then adrE.ezaAd_PLZ = ceeZIP
If ceeCity <> "" Then adrE.ezaAd_Ort = ceeCity
If ceeStreet <> "" Then adrE.ezaAd_StrasseHausNr1 = ceeStreet
End If
EZA.eza_ADRESSEN.Add(adrE)
End If
End If
' ---------- 3) ITEM-TABELLE (optional) ----------
' Finde Titelzeile "Item Lines (add as many as needed)" in Spalte A
Dim rowItemsTitle As Integer = -1
For r = 10 To Math.Min(200, usedRows + 10)
If String.Equals(GetCellStr(ws, r, 1), "Item Lines (add as many as needed)", StringComparison.OrdinalIgnoreCase) Then
rowItemsTitle = r
Exit For
End If
Next
If rowItemsTitle > 0 Then
Dim rowHdr As Integer = rowItemsTitle + 1
Dim usedCols As Integer = ws.UsedRange.Columns.Count
' Header-Indices (alle optional)
Dim cLine As Integer = -1, cArticle As Integer = -1, cDesc As Integer = -1, cShortDesc As Integer = -1
Dim cHs As Integer = -1, cOrigin As Integer = -1, cPkgs As Integer = -1, cPkgType As Integer = -1
Dim cGross As Integer = -1, cNet As Integer = -1, cUnit As Integer = -1, cTotal As Integer = -1, cCurr As Integer = -1
Dim c As Integer
For c = 1 To usedCols
Dim h As String = GetCellStr(ws, rowHdr, c).ToLowerInvariant()
Select Case h
Case "line no.", "line no" : cLine = c
Case "article no.", "article no" : cArticle = c
Case "goods description" : cDesc = c
Case "short description" : cShortDesc = c
Case "hs code" : cHs = c
Case "origin country" : cOrigin = c
Case "packages" : cPkgs = c
Case "package type" : cPkgType = c
Case "gross weight (kg)" : cGross = c
Case "net weight (kg)" : cNet = c
Case "unit price" : cUnit = c
Case "total value" : cTotal = c
Case "currency" : cCurr = c
End Select
Next
' Datenzeilen lesen: ab rowHdr+1 bis zur ersten komplett leeren Zeile
Dim rData As Integer = rowHdr + 1
Dim lastRow As Integer = ws.UsedRange.Rows.Count + 5
While rData <= lastRow
Dim anyVal As Boolean = False
For c = 1 To usedCols
If GetCellStr(ws, rData, c) <> "" Then
anyVal = True
Exit For
End If
Next
If Not anyVal Then Exit While
' Werte nur holen, wenn es die Spalten gibt
Dim descTxt As String = If(cDesc > 0, GetCellStr(ws, rData, cDesc), "")
Dim hs As String = If(cHs > 0, GetCellStr(ws, rData, cHs), "")
' Wenn gar nichts Sinnvolles da ist, Zeile überspringen
If descTxt = "" AndAlso hs = "" AndAlso (cArticle <= 0 OrElse GetCellStr(ws, rData, cArticle) = "") Then
rData += 1
Continue While
End If
Dim pos As New cDakosy_EZA_Warenposition()
If cLine > 0 Then pos.ezaWP_PositionsNummer = GetCellStr(ws, rData, cLine)
If cArticle > 0 Then pos.ezaWP_Artikelnummer = GetCellStr(ws, rData, cArticle)
Dim shortTxt As String = If(cShortDesc > 0, GetCellStr(ws, rData, cShortDesc), "")
If shortTxt <> "" Then
pos.ezaWP_Warenbezeichnung = shortTxt
ElseIf descTxt <> "" Then
pos.ezaWP_Warenbezeichnung = descTxt
End If
If hs <> "" Then pos.ezaWP_WarennummerEZT = hs
' Optional: Zollartikel-Stammdaten überschreiben, wenn Kundennummer vorhanden
Dim Kdnr As String = If(Not String.IsNullOrWhiteSpace(kdnrImp), kdnrImp, If(Not String.IsNullOrWhiteSpace(kdnrCons), kdnrCons, ""))
If Kdnr <> "" Then
Try
Dim ZAL = cZollArtikel.GetListByKundenNr(Kdnr) ' Annahme: Methode vorhanden
' Artikelnummer als Schlüssel: nur wenn vorhanden
Dim artKey As String = If(cArticle > 0, GetCellStr(ws, rData, cArticle), "")
If Not String.IsNullOrWhiteSpace(artKey) AndAlso ZAL IsNot Nothing Then
Dim Artikel = cZollArtikel.FindZollArtikelByNummer(ZAL, artKey)
If Artikel IsNot Nothing Then
If Artikel.zollArt_Warenbeschreibung IsNot Nothing AndAlso Artikel.zollArt_Warenbeschreibung.ToString() <> "" Then
pos.ezaWP_Warenbezeichnung = Artikel.zollArt_Warenbeschreibung.ToString()
End If
If Artikel.zollArt_Warencodenummer IsNot Nothing AndAlso Artikel.zollArt_Warencodenummer.ToString() <> "" Then
pos.ezaWP_WarennummerEZT = Artikel.zollArt_Warencodenummer.ToString()
End If
End If
End If
Catch
' Stammdaten-Lookup ist optional; Fehler hier nicht fatal
End Try
End If
Dim origin As String = If(cOrigin > 0, GetCellStr(ws, rData, cOrigin).ToUpperInvariant(), "")
If origin.Length >= 2 Then pos.ezaWP_UrsprungslandCode = origin.Substring(0, 2)
If cPkgs > 0 Then
Dim pk As String = GetCellStr(ws, rData, cPkgs)
If pk <> "" Then pos.ezaWP_PackstueckAnzahl = pk
End If
If cPkgType > 0 Then
Dim pt As String = GetCellStr(ws, rData, cPkgType)
If pt <> "" Then pos.ezaWP_PackstueckArt = pt
End If
If cGross > 0 Then
Dim g As Double = ToDoubleSafeVERAGTmpl(GetCellStr(ws, rData, cGross))
If g > 0 Then pos.ezaWP_Rohmasse = g
End If
If cNet > 0 Then
Dim n As Double = ToDoubleSafeVERAGTmpl(GetCellStr(ws, rData, cNet))
If n > 0 Then pos.ezaWP_Eigenmasse = n
End If
If cTotal > 0 Then
Dim totalVal As Double = ToDoubleSafeVERAGTmpl(GetCellStr(ws, rData, cTotal))
pos.ezaWP_Artikelpreis = totalVal
End If
Dim curr As String = If(cCurr > 0, GetCellStr(ws, rData, cCurr).ToUpperInvariant(), "")
If curr = "" Then
If header.ContainsKey("Currency") Then
pos.ezaWP_ArtikelpreisWaehrung = header("Currency").ToUpperInvariant()
Else
pos.ezaWP_ArtikelpreisWaehrung = "EUR"
End If
Else
pos.ezaWP_ArtikelpreisWaehrung = curr
End If
If HandelsRgNr <> "" Then
Try
pos.ezaWP_UNTERLAGEN.Add(New DAKOSY_Worker.cDakosy_EZA_WarenpositionVorgelegteUnterlagen With {
.ezaWpUl_Art = "N380",
.ezaWpUl_Bereich = "4",
.ezaWpUl_VorlageKz = "J",
.ezaWpUl_Nummer = HandelsRgNr,
.ezaWpUl_DatumAusstellung = Nothing
})
Catch
End Try
End If
EZA.eza_WARENPOS.Add(pos)
cnt += 1
rData += 1
End While
End If ' rowItemsTitle > 0 (wenn nicht gefunden: Items optional Abschnitt wird einfach übersprungen)
Catch ex As Exception
MsgBox("FEHLER beim Einlesen (" & filePath & "):" & vbCrLf & ex.Message, vbCritical)
Finally
' --- COM sauber freigeben ---
Try
If wb IsNot Nothing Then wb.Close(False)
Catch
End Try
Try
If xlApp IsNot Nothing Then xlApp.Quit()
Catch
End Try
Try
If ws IsNot Nothing Then System.Runtime.InteropServices.Marshal.FinalReleaseComObject(ws)
Catch
End Try
Try
If wb IsNot Nothing Then System.Runtime.InteropServices.Marshal.FinalReleaseComObject(wb)
Catch
End Try
Try
If xlApp IsNot Nothing Then System.Runtime.InteropServices.Marshal.FinalReleaseComObject(xlApp)
Catch
End Try
ws = Nothing : wb = Nothing : xlApp = Nothing
GC.Collect()
GC.WaitForPendingFinalizers()
End Try
Next
' --- UI Refresh wie gehabt ---
Me.FindForm.SuspendLayout()
POSITIONEN.setValues(EZA, True)
btnPositionen.PerformClick()
Me.FindForm.ResumeLayout()
MsgBox(cnt & " Datensätze wurden eingelesen.")
Me.Cursor = Cursors.Default
Return True
End Function
Private Function GetCellStr(ws As Excel.Worksheet, r As Integer, c As Integer) As String
Try
Dim v = ws.Cells(r, c).Value
Return If(v IsNot Nothing, v.ToString().Trim(), "")
Catch
Return ""
End Try
End Function
Private Function ToDoubleSafeVERAGTmpl(v As Object) As Double
If v Is Nothing Then Return 0
Dim s As String = v.ToString().Trim().Replace(",", ".")
Dim d As Double
If Double.TryParse(s, NumberStyles.Any, CultureInfo.InvariantCulture, d) Then
Return d
End If
Return 0
End Function
Private Sub VERAGFormatÖffnen2025V1ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles VERAGFormatÖffnen2025V1ToolStripMenuItem.Click
Try
' Zielpfad im Temp-Ordner festlegen
Dim tempFile As String = System.IO.Path.Combine(System.IO.Path.GetTempPath(), "Customs_Clearance_Template_2025V1.xlsx")
' Ressource (als Binärdatei eingebunden) schreiben
System.IO.File.WriteAllBytes(tempFile, My.Resources.Customs_Clearance_Template)
' Datei mit dem Standardprogramm öffnen (z. B. Excel)
Process.Start(New ProcessStartInfo(tempFile) With {.UseShellExecute = True})
Catch ex As Exception
MsgBox("Fehler beim Öffnen der Vorlage: " & ex.Message, vbCritical)
End Try
End Sub
'================================================================================================================================
'================================================================================================================================
'================================================================================================================================
End Class