edv/ADMIN
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

neu

Browse Source
This commit is contained in:
Andreas Luxbauer
2020-11-27 22:57:00 +01:00
parent fa670231f7
commit 14a7113144
22 changed files with 872 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

263
UID/usrctlProcedures.vb
View File

@@ -2489,7 +2489,7 @@ Public Class usrctlProcedures
If s.ToString.Length > l Then
Return s.Substring(0, l)
End If
Return s
Return s.ToString
Catch ex As Exception
MsgBox("getTrimedString: " & ex.Message & ex.StackTrace)
@@ -2985,8 +2985,269 @@ Public Class usrctlProcedures
End Sub
Private Sub Button29_Click(sender As Object, e As EventArgs) Handles Button29.Click
Dim StartZeit As Date = DateTime.Now
Dim StopZeit As Date = DateTime.Now
Dim test = VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM
VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = CheckBox5.Checked
Dim cnt = 1
'dim listAVISO = New List(Of cAviso)
Dim sql As New VERAG_PROG_ALLGEMEIN.SQL
Dim kdnr_tmp = ""
Try
Dim fd As New OpenFileDialog
fd.InitialDirectory = "C:\Users\DEVELOPER1\Desktop\"
If fd.ShowDialog = DialogResult.OK Then
If fd.FileName.ToUpper.EndsWith(".XLSX") Then
Dim exclApp As Object 'as Application
Dim Datei As Object 'as WorkBook
Dim Blatt As Object 'as WorkSheet
exclApp = CreateObject("Excel.Application")
' Dim nWeek As Integer
' nWeek = DatePart(DateInterval.WeekOfYear, New Date(2004, 3, 22), _
' FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFourDays)
' exclApp.Caption = GuiId
exclApp.CutCopyMode = False
Datei = exclApp.Workbooks.Open(fd.FileName)
Blatt = Datei.Worksheets(1)
Datei.Activate()
For index = 2 To Blatt.UsedRange.Rows.Count '2
' MsgBox(Blatt.Range("C" & index).Value)
'Dim valueX As String = ""
Try
'valueX = Blatt.Range("C" & index).Value.ToString
'MsgBox(valueX)
If Blatt.Range("B" & index).Value IsNot Nothing AndAlso Blatt.Range("B" & index).Value.ToString <> "" Then
'MsgBox(Blatt.Range("A" & index).Value)
'MsgBox(Blatt.Range("A" & index).Value IsNot Nothing)
'MsgBox(Blatt.Range("A" & index).Value.ToString <> "")
'MsgBox(IsNumeric(Blatt.Range("A" & index).Value))
Dim kdnr As Integer = 3000001
If Blatt.Range("A" & index).Value IsNot Nothing AndAlso Blatt.Range("A" & index).Value.ToString <> "" AndAlso IsNumeric(Blatt.Range("A" & index).Value) Then
kdnr = CInt(Blatt.Range("A" & index).Value) + 3000000
Else
kdnr = VERAG_PROG_ALLGEMEIN.cAdressen.getHoechsteKdNr(3020000, 3499999) '+ 1
End If
Dim KD As New VERAG_PROG_ALLGEMEIN.cKunde(kdnr)
'If True Then 'Not KD.hasEntry Then
' MsgBox((Blatt.Range("C" & index).Value.ToString))
Dim AD As New VERAG_PROG_ALLGEMEIN.cAdressen(kdnr)
Dim KDE As New VERAG_PROG_ALLGEMEIN.cKundenErweitert(kdnr)
AD.Auswahl = "A"
If Blatt.Range("H" & index).Value Is Nothing OrElse Blatt.Range("H" & index).Value.ToString = "" Then
AD.Ordnungsbegriff = getTrimedString(Blatt.Range("B" & index).Value, 40)
Else
AD.Ordnungsbegriff = getTrimedString((Blatt.Range("B" & index).Value) & "; " & (Blatt.Range("H" & index).Value), 40)
End If
AD.Name_1 = getTrimedString(Blatt.Range("B" & index).Value, 40)
AD.Name_2 = Nothing
AD.Straße = getTrimedString(Blatt.Range("C" & index).Value, 40)
If If(AD.Straße, "").trim = "" Then AD.Straße = Nothing
AD.Ort = getTrimedString(Blatt.Range("H" & index).Value, 40)
If If(AD.Ort, "").trim = "" Then AD.Ort = "-"
Dim LandKz = getTrimedString(Blatt.Range("F" & index).Value, 3)
Dim PLZ = getTrimedString(Blatt.Range("G" & index).Value, 7)
AD.PLZ = sql.isleernothing(getTrimedString(PLZ.Trim, 7))
AD.LandKz = sql.isleernothing(getTrimedString(LandKz.Trim, 3))
If Blatt.Range("K" & index).value IsNot Nothing Then
If Blatt.Range("K" & index).Value.ToString.Length > 20 Then
AD.Mobiltelefon = getTrimedString(Blatt.Range("K" & index).Value.ToString, 40)
Else
AD.Telefon = getTrimedString(Blatt.Range("K" & index).Value.ToString, 20)
End If
End If
If If(AD.Telefon, "").trim = "" Then AD.Telefon = Nothing
AD.Mobiltelefon = Nothing
AD.Telefax = Nothing
AD.E_Mail = getTrimedString(Blatt.Range("L" & index).Value, 40)
If If(AD.E_Mail, "").trim = "" Then AD.E_Mail = Nothing
AD.E_Mail2 = Nothing
' AD. = row("Internet1")
If Blatt.Range("J" & index).value IsNot Nothing Then AD.Ansprechpartner = getTrimedString(Blatt.Range("J" & index).Value.ToString, 40)
If If(AD.Ansprechpartner, "").trim = "" Then AD.Ansprechpartner = Nothing
KD.Währungscode = "EUR" 'getTrimedStringACCES(row("Standard FakturenWährung"), 3)
KD.Zahlungsziel = Nothing
' Offerte ??
KDE.kde_BesonderheitenNeu = True
Dim Allg = ""
VERAG_PROG_ALLGEMEIN.cKundenBesonderheiten.DELETE_ALL_KD(kdnr)
If Blatt.Range("M" & index).value IsNot Nothing AndAlso Blatt.Range("M" & index).value <> "" Then
addbesonderheit(kdnr, "ÖFFNUNGSZEITEN: " & Blatt.Range("M" & index).Value.ToString)
End If
If Blatt.Range("Q" & index).value IsNot Nothing AndAlso Blatt.Range("Q" & index).value <> "" Then
addbesonderheit(kdnr, "ZOLLAGENT: " & Blatt.Range("Q" & index).Value.ToString)
End If
If Blatt.Range("I" & index).value IsNot Nothing AndAlso Blatt.Range("I" & index).value <> "" Then
addbesonderheit(kdnr, Blatt.Range("I" & index).Value.ToString)
End If
KD.Besonderheiten = isleernothing(Allg.Trim)
Dim obtmp = getTrimedStringACCES(AD.Ordnungsbegriff, 31)
If AD.doesOrdnungsbegriffExist Then
AD.Ordnungsbegriff = obtmp & " (AMBAR)"
End If
If AD.doesOrdnungsbegriffExist Then
AD.Ordnungsbegriff = obtmp & " (AMBAR2)"
End If
If AD.doesOrdnungsbegriffExist Then
AD.Ordnungsbegriff = obtmp & " (AMBAR3)"
End If
If AD.doesOrdnungsbegriffExist Then
AD.Ordnungsbegriff = obtmp & " (AMBAR4)"
End If
AD.Ordnungsbegriff = getTrimedString(AD.Ordnungsbegriff, 40)
If Blatt.Range("N" & index).value IsNot Nothing AndAlso Blatt.Range("N" & index).value.ToString <> "" AndAlso Blatt.Range("N" & index).value.ToString.Length > 4 Then
Dim uidvalue = Blatt.Range("N" & index).value.trim.ToString.Replace(" ", "")
If IsNumeric(uidvalue.Trim.Substring(2)) Then 'DE
AD.UstIdKz = getTrimedString(uidvalue, 2)
AD.UstIdNr = getTrimedString(uidvalue.Trim.Substring(2), 12)
ElseIf IsNumeric(uidvalue.Trim.Substring(3)) Then 'ATU
AD.UstIdKz = getTrimedString(uidvalue, 2)
AD.UstIdNr = getTrimedString(uidvalue.Trim.Substring(2), 12)
End If
End If
If Blatt.Range("P" & index).value IsNot Nothing Then KD.EORITIN = getTrimedString(Blatt.Range("P" & index).Value.ToString, 17)
KD.KundenNrZentrale = KD.KundenNr
KD.FilialenNr = 5701
If If(KD.Sachbearbeiter, "").trim = "" Then KD.Sachbearbeiter = "AUTO"
KD.Währungscode = "EUR"
KD.Eingegeben_am = Now.ToShortDateString
' AD.Ordnungsbegriff = getTrimedString(AD.Name_1 & "; " & AD.Ort, 50)
AD.Eingegeben_am = Now.ToShortDateString
AD.LandKz = If(isleernothing(cProgramFunctions.getISO1Land(AD.LandKz)), AD.LandKz)
AD.Rechnungsdruck = True
If If(KD.EORITIN, "").trim = "" Then KD.EORITIN = Nothing
KD.Vorlageprovision = 0.01
KD.Kreditaufwendungen = 0.02
KD.Bankspesen = 0
KD.SVS = True
KD.Bankspesen_Mindestbetrag = 0
KD.Sammelrechnung = 0
KD.Steuerschlüssel = 10
KD.Kreditlimit = 2600
KD.Überwachungskunde = 0
KD.Abfertigungsverbot = 0
KD.Rechtsanwalt = 0
KD.Euroeinführung = CDate("01.01.2002")
KD.UStV_Summe3470BetragEUR = 0
KD.UStV_SummeErstattungsbetragEUR = 0
KD.UStV_SummeVorschaubetragEUR = 0
KD.UStV_SummeVorschaubetragEUR_IDS = 0
KD.UStV_SummeVorschaubetragEUR_VERAG = 0
KD.UStV_SummeUmsatzsteuerbetragEUR = 0
KD.UStV_SummeVZBetragEUR = 0
KD.Fiskal_Aktiv = 0
If AD.SAVE() AndAlso KD.SAVE() Then ' AndAlso KDE.SAVE() Then
TextBox10.Text &= AD.AdressenNr & " " & AD.Ordnungsbegriff & vbNewLine
Else
MsgBox("FEHLER: " & index)
End If
'Item(0) = row(0)
'Item(1) = row(1)
'Dim NextListItem As New ListViewItem(Item)
'ListView1.Items.Add(NextListItem)
Label15.Text = cnt & "/" & Blatt.UsedRange.Rows.Count
cnt += 1
Me.Refresh()
End If
Catch ex As Exception
MsgBox(ex.Message & ex.StackTrace)
End Try
Next
End If
End If
Catch ex As Exception
MessageBox.Show(ex.Message & ex.StackTrace)
Finally
End Try
VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = test
End Sub
Sub addbesonderheit(kdnr, text, Optional art = "ZOLL")
Dim KD_BESONSERHEITEN As New VERAG_PROG_ALLGEMEIN.cKundenBesonderheiten
KD_BESONSERHEITEN.kdb_EingetragenAm = Now
KD_BESONSERHEITEN.kdb_history = 0
KD_BESONSERHEITEN.kdb_mitName = "AUTO"
KD_BESONSERHEITEN.kdb_mitId = 4
KD_BESONSERHEITEN.kdb_KundenNr = kdnr
KD_BESONSERHEITEN.kdb_AenderungAm = Now
KD_BESONSERHEITEN.kdb_kategorie = art
KD_BESONSERHEITEN.kdb_text = text
KD_BESONSERHEITEN.kdb_hervorheben = False
'KD_BESONSERHEITEN.kdb_visible =
KD_BESONSERHEITEN.SAVE()
End Sub
'Private Sub Button26_Click(sender As Object, e As EventArgs)
' For Each d In System.IO.Directory.GetDirectories("\\192.168.0.91\Datenarchiv\DAKOSY\ECHTSYSTEM\Nachrichtendaten_Ablage\2019")
' Dim fi As New FileInfo(d)