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

1569 lines
72 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 System.Globalization
Imports DAKOSY_Worker
Imports Microsoft.Office.Interop
Imports VERAG_PROG_ALLGEMEIN
Public Class cATLAS_EZA_IMPORT
Public EZA As DAKOSY_Worker.cDakosyEZA
Dim AVISO As cAviso
Dim SENDUNG As cSendungen
Sub New(AVISO, SENDUNG, EZA)
' Dieser Aufruf ist für den Designer erforderlich.
InitializeComponent()
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
Me.EZA = EZA
Me.SENDUNG = SENDUNG
Me.AVISO = AVISO
End Sub
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Me.Cursor = Cursors.WaitCursor
importExcel_DynamicAutomotive()
Me.Cursor = Cursors.Default
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
' --- 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
If f.LIST_FILES Is Nothing OrElse f.LIST_FILES.Count > 1 Then MsgBox("Nur 1 File auswählen!") : Return False
Dim filepath = f.LIST_FILES(0)
If Not filepath.ToLower.EndsWith(".xls") And Not filepath.ToLower.EndsWith(".xlsx") Then
Me.Cursor = Cursors.Default
Return False
End If
If True 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(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_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)
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR("Fehler beim Einlesen der Excel-Datei!" & vbNewLine & ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
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()
MsgBox(cnt & " Datensätze wurden eingelesen. ")
Me.Cursor = Cursors.Default
Me.DialogResult = DialogResult.OK
Me.Close()
Catch ex As Exception
'
Me.Cursor = Cursors.Default
'MsgBox("FEHLER! Datei im richtigen Format?" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR("FEHLER! Datei im richtigen Format?" & vbNewLine & ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
' 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(OP_addKN8, OP_translate, OP_TNR8to11) 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
If f.LIST_FILES Is Nothing OrElse f.LIST_FILES.Count > 1 Then MsgBox("Nur 1 File auswählen!") : Return False
Dim filepath = f.LIST_FILES(0)
If Not filepath.ToLower.EndsWith(".xls") And Not filepath.ToLower.EndsWith(".xlsx") Then
Me.Cursor = Cursors.Default
Return False
End If
If True 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(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_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
If cnt = 0 Then
POSITION.ezaWP_PackstueckAnzahl = SENDUNG.tblSnd_Colli
POSITION.ezaWP_PackstueckArt = "PK"
End If
POSITION.ezaWP_WarennummerEZT = myArray(i, 9).ToString()
'POSITION.ezaWP_PackstueckAnzahl = 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()
'-------------------------------------------------------
If OP_translate Then
cDeeplAPI.deepl_Translate(POSITION.ezaWP_Warenbezeichnung, POSITION.ezaWP_Warenbezeichnung, "DE")
End If
If OP_addKN8 Then
If POSITION.ezaWP_WarennummerEZT.ToString.Length >= 8 Then
Dim Kn8Text = cTariffKN8_Interface.getKN8FromTNR(POSITION.ezaWP_WarennummerEZT.ToString.Substring(0, 8))
POSITION.ezaWP_Warenbezeichnung = Kn8Text & ",hier: " & If(POSITION.ezaWP_Warenbezeichnung, "")
End If
End If
If If(POSITION.ezaWP_Warenbezeichnung, "").Length > 240 Then
POSITION.ezaWP_Warenbezeichnung = POSITION.ezaWP_Warenbezeichnung.Substring(0, 240)
End If
'Wenn EZT Nummer 8-stellig ist, dann auf 11-stellig erweitern
If OP_TNR8to11 Then
If If(POSITION.ezaWP_WarennummerEZT, "") <> "" AndAlso (POSITION.ezaWP_WarennummerEZT.ToString.Length >= 8 And POSITION.ezaWP_WarennummerEZT.ToString.Length < 11) Then
Dim COMM_TARIFF = VERAG_PROG_ALLGEMEIN.cATEZ_Tariff.GetFullTariff_Only1Result(POSITION.ezaWP_WarennummerEZT, "TR", cboTnrDrc_Geze._value, cboTnrTrg_Geze._value)
' MsgBox(COMM_TARIFF)
If COMM_TARIFF <> "" Then
POSITION.ezaWP_WarennummerEZT = COMM_TARIFF
End If
End If
End If
'-------------------------------------------------------
'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)
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR("Fehler beim Einlesen der Excel-Datei!" & vbNewLine & ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
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.Cursor = Cursors.Default
Me.DialogResult = DialogResult.OK
Me.Close()
Catch ex As Exception
'
Me.Cursor = Cursors.Default
'MsgBox("FEHLER! Datei im richtigen Format?" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR("FEHLER! Datei im richtigen Format?" & vbNewLine & ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
' 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
' --- 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
If f.LIST_FILES Is Nothing OrElse f.LIST_FILES.Count > 1 Then MsgBox("Nur 1 File auswählen!") : 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 f.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
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR("Fehler beim Einlesen der Excel-Datei!" & vbNewLine & ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
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
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR("FEHLER! Datei im richtigen Format?" & vbNewLine & ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
' 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
MsgBox(cnt & " Datensätze wurden eingelesen. ")
Me.Cursor = Cursors.Default
Me.DialogResult = DialogResult.OK
Me.Close()
Return True
End Function
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Me.Cursor = Cursors.WaitCursor
importExcel_Geze(cbxGezeKN8.Checked, cbxGezeTranslate.Checked, cbxGezeTNR8to11.Checked)
Me.Cursor = Cursors.Default
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Me.Cursor = Cursors.WaitCursor
importExcel_MEYLE()
Me.Cursor = Cursors.Default
End Sub
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
Me.Cursor = Cursors.WaitCursor
importExcel_Fressnapf()
Me.Cursor = Cursors.Default
End Sub
Private Function importExcel_Fressnapf() 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
If f.LIST_FILES Is Nothing OrElse f.LIST_FILES.Count > 1 Then MsgBox("Nur 1 File auswählen!") : 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 f.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
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR("FEHLER beim Einlesen: " & vbCrLf & ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
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
MsgBox(cnt & " Datensätze wurden eingelesen.")
Me.Cursor = Cursors.Default
Me.DialogResult = DialogResult.OK
Me.Close()
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 Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Me.Cursor = Cursors.WaitCursor
ImportExcel_CustomsTemplate_V1(cbxVERAG_V1_Kn8.Checked, cbxVERAG_V1_translate.Checked, cbxVERAG_V1_TNR8to11.Checked)
Me.Cursor = Cursors.Default
'ImportExcel_CustomsTemplate_V1_1(cbxVERAG_V1_Kn8.Checked, cbxVERAG_V1_translate.Checked, cbxVERAG_V1_TNR8to11.Checked)
End Sub
'================================================================================================================================
'================================================================================================================================
'================================================================================================================================
Public Function ImportExcel_CustomsTemplate_V1(OP_addKN8, OP_translate, OP_TNR8to11) 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 V1 und V1.1 unterstützt ----------
Dim versionTag As String = GetCellStr(ws, 2, 8) ' H2
If Not String.Equals(versionTag, "2025-V1", StringComparison.OrdinalIgnoreCase) Or
Not String.Equals(versionTag, "2025-V1.1", 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 = ""
Dim HandelsRgDat As String = ""
If header.ContainsKey("Invoice No.") Then HandelsRgNr = header("Invoice No.")
If header.ContainsKey("Invoice Date") Then HandelsRgDat = header("Invoice Date")
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 cPrefCountry = "", cBenefit = "", cCurrProc = "", cPrevProc = "", cprefCode = "", cprefDocNo = "", cYCodes = ""
Dim c As Integer
For c = 1 To usedCols
Dim h As String = GetCellStr(ws, rowHdr, c).ToLowerInvariant().Replace(vbNewLine, "")
h = h.Replace("(optional)", "").Trim()
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
'Case "Invoice Line No."
Case "preferential country origin" : cPrefCountry = c
Case "preferential treatment / benefit" : cBenefit = c
Case "requested procedure" : cCurrProc = c
Case "previous procedure" : cPrevProc = c
Case "preference code" : cprefCode = c
Case "preferential document no" : cprefDocNo = c
Case "y-codes" : cYCodes = 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
Dim tariffCache As New Dictionary(Of String, String)
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
'------------------------------------------------
If OP_translate Then
cDeeplAPI.deepl_Translate(pos.ezaWP_Warenbezeichnung, pos.ezaWP_Warenbezeichnung, "DE")
End If
If OP_addKN8 Then
If pos.ezaWP_WarennummerEZT.ToString.Length >= 8 Then
Dim Kn8Text = cTariffKN8_Interface.getKN8FromTNR(pos.ezaWP_WarennummerEZT.ToString.Substring(0, 8))
pos.ezaWP_Warenbezeichnung = Kn8Text & ",hier: " & If(pos.ezaWP_Warenbezeichnung, "")
End If
End If
If If(pos.ezaWP_Warenbezeichnung, "").Length > 240 Then
pos.ezaWP_Warenbezeichnung = pos.ezaWP_Warenbezeichnung.Substring(0, 240)
End If
'Wenn EZT Nummer 8-stellig ist, dann auf 11-stellig erweitern
If OP_TNR8to11 Then
If If(pos.ezaWP_WarennummerEZT, "") <> "" AndAlso (pos.ezaWP_WarennummerEZT.ToString.Length >= 8 And pos.ezaWP_WarennummerEZT.ToString.Length < 11) Then
Dim hsTmp = pos.ezaWP_WarennummerEZT.ToString()
Dim COMM_TARIFF As String = ""
' Prüfen ob bereits abgefragt
If tariffCache.ContainsKey(hsTmp) Then
pos.ezaWP_WarennummerEZT = tariffCache(hsTmp)
Else
pos.ezaWP_WarennummerEZT = VERAG_PROG_ALLGEMEIN.cATEZ_Tariff.GetFullTariff_Only1Result(hsTmp, cboTnrSrc_VERAGImp._value, cboTnrTrg_VERAGImp._value)
tariffCache(hsTmp) = pos.ezaWP_WarennummerEZT
End If
End If
End If
'------------------------------------------------
If If(pos.ezaWP_Warenbezeichnung, "").Length > 240 Then
pos.ezaWP_Warenbezeichnung = pos.ezaWP_Warenbezeichnung.Substring(0, 240)
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 cPrefCountry <> "" Then
If cPrefCountry.Length >= 2 Then pos.ezaWP_Praeferenzursprungsland = origin.Substring(0, 2)
End If
If cBenefit <> "" Then
pos.ezaWP_BeguenstigungBenatragtCode = cBenefit
End If
If cPrevProc <> "" Then
pos.ezaWP_VerfahrensCodeVorangegangenesVerfahren = cPrevProc
End If
If cCurrProc <> "" Then
pos.ezaWP_AnmeldeVErfahren = cCurrProc
End If
If cYCodes <> "" Then
cYCodes = cYCodes.Replace(";", ",").Replace("/", ",").Replace("+", ",").Replace("-", ",")
If cYCodes.Contains(",") Then
Dim s = cYCodes.Split(",")
For Each ycode In s
If ycode.Trim() <> "" Then
pos.ezaWP_UNTERLAGEN.Add(New DAKOSY_Worker.cDakosy_EZA_WarenpositionVorgelegteUnterlagen With {
.ezaWpUl_Art = ycode.Trim(),
.ezaWpUl_Bereich = "5",
.ezaWpUl_VorlageKz = "J",
.ezaWpUl_Nummer = cprefDocNo,
.ezaWpUl_DatumAusstellung = Nothing
})
End If
Next
Else
pos.ezaWP_UNTERLAGEN.Add(New DAKOSY_Worker.cDakosy_EZA_WarenpositionVorgelegteUnterlagen With {
.ezaWpUl_Art = cYCodes,
.ezaWpUl_Bereich = "5",
.ezaWpUl_VorlageKz = "J",
.ezaWpUl_Nummer = cprefDocNo,
.ezaWpUl_DatumAusstellung = Nothing
})
End If
End If
If cprefCode <> "" And cprefDocNo <> "" Then
Try
Dim Pref_art = ""
Dim Pref_bereich = ""
If cprefCode.Contains("/") Then
Dim s = cprefCode.Split("/")
Pref_art = s(1)
Pref_bereich = s(0)
Else
Pref_art = cprefCode
Select Case cprefCode
Case "N954" : Pref_bereich = "3"
Case "N018" : Pref_bereich = "6"
Case "ATR", "A.TR" : Pref_bereich = "N018" : Pref_art = "6"
Case "EUR1", "EUR.1" : Pref_bereich = "N954" : Pref_art = "3"
End Select
End If
pos.ezaWP_UNTERLAGEN.Add(New DAKOSY_Worker.cDakosy_EZA_WarenpositionVorgelegteUnterlagen With {
.ezaWpUl_Art = Pref_art,
.ezaWpUl_Bereich = Pref_bereich,
.ezaWpUl_VorlageKz = "J",
.ezaWpUl_Nummer = cprefDocNo,
.ezaWpUl_DatumAusstellung = Nothing
})
Catch
End Try
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 = If(HandelsRgDat <> "" AndAlso IsDate(HandelsRgDat), CDate(HandelsRgDat).ToShortDateString, 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 ---
MsgBox(cnt & " Datensätze wurden eingelesen.")
Me.Cursor = Cursors.Default
Me.DialogResult = DialogResult.OK
Me.Close()
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 Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click, Button7.Click
Try
' Zielpfad im Temp-Ordner festlegen
Dim tempFile As String = ""
If sender Is Button7 Then : tempFile = System.IO.Path.Combine(System.IO.Path.GetTempPath(), "Customs_Clearance_Template_2025V1.xlsx")
ElseIf sender Is Button4 Then : tempFile = System.IO.Path.Combine(System.IO.Path.GetTempPath(), "Customs_Clearance_Template_V1.1.xlsx")
End If
' 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