Imports System.DirectoryServices Imports System.Collections.Generic Imports PdfSharp.Pdf Imports PdfSharp.Drawing Imports PdfSharp.Pdf.IO Imports PdfSharp.Pdf.AcroForms Imports iTextSharp.text.pdf Imports System.IO Imports System.Data.SqlClient Imports System.Net.Mail Imports Microsoft.Office.Interop Imports System.Net Imports System.Text Imports System.Xml.Serialization Imports System.Xml Imports System.Data.OleDb 'Imports Microsoft.Office.Interop Public Class usrctlProcedures 'Private hwAddress As TAddress = Nothing 'Private mediaTypes As Integer 'Private WithEvents tapiCls As TTapi 'Private Const mediaAudio = JulMar.Tapi3.TAPIMEDIATYPES.AUDIO 'Private Const mediaData = JulMar.Tapi3.TAPIMEDIATYPES.DATAMODEM 'Private Const mediaVideo = JulMar.Tapi3.TAPIMEDIATYPES.VIDEO 'Private Const mediaFax = JulMar.Tapi3.TAPIMEDIATYPES.G3FAX 'Private Const mediaMultitrack = JulMar.Tapi3.TAPIMEDIATYPES.MULTITRACK 'Private offeringCall As Boolean = False 'Private connectedCall As Boolean = False 'Private inProgressCall As Boolean = False 'Private incomingCall As TCall 'Public Sub New() ' tapiCls = New TTapi ' tapiCls.Initialize() ' 'Discover all hardware addresses ' 'Make "And" function to discover different media devices ' For Each address In tapiCls.Addresses ' If address.State = ADDRESS_STATE.AS_INSERVICE Then ' mediaTypes = address.MediaTypes ' 'We discover and select the audio device usually to be a modem ' If (mediaTypes And mediaAudio) = mediaAudio Then ' hwAddress = address ' hwAddress.Open(mediaAudio) ' 'This will show the name of the audio devices discovered ' 'MsgBox(hwAddress.AddressName.ToString) ' End If ' End If ' Next ' 'If an hardware has not been found ' If hwAddress Is Nothing Then ' 'Hardware address not found ' End If 'End Sub 'Public Sub openLine() ' 'Put modem wake up to listem to the line ' Try ' If hwAddress.State = ADDRESS_STATE.AS_INSERVICE Then ' hwAddress.Open(mediaAudio) ' End If ' Catch ex As Exception ' 'Manage the exception ' End Try 'End Sub 'Public Sub closeLine() ' 'Put modem shut down ' Try ' If hwAddress.State = ADDRESS_STATE.AS_INSERVICE Then ' hwAddress.Close() ' End If ' Catch ex As Exception ' 'Manage the exception ' End Try 'End Sub 'Public Sub answerCall() ' If offeringCall = True Then ' incomingCall.Answer() ' End If 'End Sub 'Public Sub hungup() ' If connectedCall = True Then ' incomingCall.Disconnect(DISCONNECT_CODE.DC_REJECTED) ' End If 'End Sub 'Private Sub tapiCallNotification_Event(ByVal sender As Object, ' ByVal e As TapiCallNotificationEventArgs) Handles tapiCls.TE_CALLNOTIFICATION ' 'MsgBox("Call notification") ' Select Case e.Event ' Case CALL_NOTIFICATION_EVENT.CNE_MONITOR ' 'Choose you action ' Case CALL_NOTIFICATION_EVENT.CNE_OWNER ' 'Choose you action ' End Select 'End Sub 'Private Sub tapiInfoChange_Event(ByVal sender As Object, ' ByVal e As TapiCallInfoChangeEventArgs) Handles tapiCls.TE_CALLINFOCHANGE ' Dim callerNumber As String = "" ' Try ' callerNumber = e.Call.CallInfo(CALLINFO_STRING.CIS_CALLERIDNUMBER).ToString ' If callerNumber.Length = 0 Then ' 'Hidden number ' Else ' 'Clear number ' End If ' Catch ex As Exception ' 'Manage the exception ' End Try 'End Sub 'Private Sub tapiGeneral_Event(ByVal sender As Object, ' ByVal e As TapiCallStateEventArgs) Handles tapiCls.TE_CALLSTATE ' ' MsgBox(e.State.ToString) ' Select Case e.State ' Case CALL_STATE.CS_UNKNOWN ' Case CALL_STATE.CS_OFFERING ' 'When a call is coming in during the ring tone ' offeringCall = True ' Case CALL_STATE.CS_CONNECTED ' 'When a call is answered ' connectedCall = True ' offeringCall = False ' Case CALL_STATE.CS_HOLD ' Case CALL_STATE.CS_IDLE ' Case CALL_STATE.CS_INPROGRESS ' Case CALL_STATE.CS_QUEUED ' Case CALL_STATE.CS_DISCONNECTED ' 'When a call is in conversation or closed ' connectedCall = False ' End Select 'End Sub 'Private Sub tapiGenerate_Event(ByVal sender As Object, ' ByVal e As TapiDigitGenerationEventArgs) Handles tapiCls.TE_GENERATEEVENT ' ' MsgBox("GENERATE") 'End Sub 'Private Sub tapiSpecific_Event(ByVal sender As Object, ' ByVal e As TapiAddressDeviceSpecificEventArgs) Handles tapiCls.TE_ADDRESSDEVSPECIFIC ' ' MsgBox("SPECIFIC EVENTS") 'End Sub 'Private Sub tapiObject_Event(ByVal sender As Object, ' ByVal e As TapiObjectEventArgs) Handles tapiCls.TE_TAPIOBJECT ' 'MsgBox("tapi object") 'End Sub 'Private Sub tapiPhone_Event(ByVal sender As Object, ' ByVal e As TapiPhoneEventArgs) Handles tapiCls.TE_PHONEEVENT ' 'MsgBox("Phone events") 'End Sub 'Private Sub tapiDigit_Event(ByVal sender As Object, ' ByVal e As TapiDigitDetectionEventArgs) Handles tapiCls.TE_DIGITEVENT ' 'MsgBox("Digit detection events") 'End Sub 'Inherits UserControl 'Public Sub New() ' InitializeComponent() 'End Sub Private Sub writeLog(ByVal text As String) tbxLog.Text = tbxLog.Text & vbNewLine & text End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click FindingThreats() End Sub Private Sub processlol() Dim strComputer, strProcess 'Do 'strProcess = InputBox("Please enter the name of the process (for instance: explorer.exe)", "Input") ' Loop Until strProcess <> "" Do strComputer = InputBox("Please enter the computer name", "Input") Loop Until strComputer <> "" strProcess = "explorer.exe" If (test(strComputer, strProcess) = True) Then MsgBox("Process " & strProcess & " is running on computer " & strComputer) Else MsgBox("Process " & strProcess & " is NOT running on computer " & strComputer) End If End Sub '************************************** ' Name: A WMI example: checks if a process is running on a (remote) computer ' Description:Checks if a process is running on a computer. Works on the local machine, but also 'on a remote computer. Based on the WMI standard. ' By: Rowen Bankx ' ' Assumes:This script requires WMI (Windows Management Interface). WMI is part of Windows 2000. For NT4, you can download it from the Microsoftt site. ' 'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=40048&lngWId=1'for details.'************************************** ' **************************************************************************** ' This function checks if a process is running on a (remote) computer ' Requires WMI ' **************************************************************************** ' Check out http://www.activxperts.com for more samples and components ' **************************************************************************** Sub test2() Try Dim ps As System.Diagnostics.Process For Each ps In System.Diagnostics.Process.GetProcesses("Zoll1") MsgBox(ps.ProcessName) Next Catch ex As Exception MsgBox(ex.Message) End Try End Sub Sub test3() Try ',authority=ntlmdomain:verag.ost.dmn Dim objDictionary = CreateObject("Scripting.Dictionary") ' Dim strComputer = "YLPS023046" '.verag.ost.dmn Dim strComputer = "DEVELOPER" '.verag.ost.dmn Dim objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,authority=kerberos:verag.ost.dmn}!\\" & strComputer & "\root\cimv2") 'impersonationLevel=impersonate Dim colProcesses = objWMIService.ExecQuery _ ("Select * from Win32_Process") For Each objProcess In colProcesses MsgBox(objProcess.Name) ' MsgBox(UCase(colProcesses.name)) ' objDictionary.Add(objProcess.ProcessID, objProcess.Name)) Next ' Dim colThreads = objWMIService.ExecQuery _ ' ("Select * from Win32_Thread") ' For Each objThread In colThreads 'Dim intProcessID = CInt(objThread.ProcessHandle) ' Dim strProcessName = objDictionary.Item(intProcessID) ' MsgBox(strProcessName & vbTab & objThread.ProcessHandle & _ ' vbTab & objThread.Handle & vbTab & objThread.ThreadState) ' Next Catch ex As Exception MsgBox(ex.Message) End Try End Sub ' Public Function GetUserName(ByVal ProcessName As String) ' Dim selectQuery As SelectQuery = New SelectQuery("Win32_Process") 'Dim searcher As ManagementObjectSearcher = New ManagementObjectSearcher(selectQuery) ' Dim y As System.Management.ManagementObjectCollection ' y = searcher.Get ' For Each proc As ManagementObject In y ' Dim s(1) As String ' proc.InvokeMethod("GetOwner", CType(s, Object())) ' Dim n As String = proc("Name").ToString() ' If n = ProcessName & ".exe" Then ' Return ("User: " & s(1) & "\\" & s(0)) ' End If ' Next ' End Function Function test(strServer, strProcess) 'Dim myobj = GetObject("WINMGMTS:" _ ' & "{impersonationLevel=impersonate," _ ' & "authenticationLevel=pktPrivacy," _ ' & "authority=ntlmdomain:verag.ost.dmn," _ ' & "(Debug,!RemoteShutdown)}" _ '& " DYIMPORT.locale=ms_409]" _ '& "!\\User1\ROOT\CIMV2:Win32_LogicalDisk=""C:""") Dim Process test = False Try Dim myobj = GetObject("WINMGMTS:{authority=ntlmdomain:verag.ost.dmn}!\\" & strServer) For Each Process In myobj.InstancesOf("win32_process") If UCase(Process.name) = UCase(strProcess) Then test = True Exit Function End If Next Catch ex As Exception MsgBox(ex.Message) End Try ' Dim wscript.echo "File system = " & myobj.filesystem End Function Function IsProcessRunning(strServer, strProcess) Dim Process, strObject IsProcessRunning = False strObject = "winmgmts://" & strServer ' strObject = "winmgmts://" & strServer ' "WinNT://verag.ost.dmn" Try For Each Process In GetObject(strObject).InstancesOf("win32_process") If UCase(Process.name) = UCase(strProcess) Then IsProcessRunning = True Exit Function End If Next Catch ex As Exception MsgBox(ex.Message) End Try End Function ' **************************************************************************** ' Main ' **************************************************************************** Private Sub GetAllUsers() Dim results As SearchResultCollection Dim ds As DirectorySearcher = Nothing Dim de As New DirectoryEntry("LDAP://verag.ost.dmn") ds = New DirectorySearcher(de) ds.Filter = "(&(objectCategory=User)(objectClass=person))" results = ds.FindAll() For Each sr As SearchResult In results MsgBox(sr.Properties("name")(0).ToString()) Next End Sub Private Function GetCurrentDomainPath() As String Dim de As New DirectoryEntry("LDAP://verag.ost.dmn") Return "LDAP://" & de.Properties("defaultNamingContext")(0).ToString() End Function Sub FindingThreats() ListView1.Items.Clear() Dim childEntry As DirectoryEntry Dim ParentEntry As New DirectoryEntry Dim str As String = "" Try ParentEntry.Path = "WinNT://verag.ost.dmn" Dim cnt As Integer = 0 For Each childEntry In ParentEntry.Children ' MsgBox(childEntry.SchemaClassName) ' If (childEntry.SchemaClassName = "User") Then 'Alle user im Netzwerk ' MsgBox(childEntry.Name) ' End If ' If Not str.Contains(childEntry.SchemaClassName) Then 'str &= childEntry.SchemaClassName & ", " 'End If If (childEntry.SchemaClassName = "Computer" And childEntry.Name = "YLPS023046") Then 'Alle user im Netzwerk ' If (childEntry.Name = "YLPS023046") Then 'Alle user im Netzwerk 'MsgBox("Herureka") ' End If ' Dim progress ' Dim remoteEDD1 As Process() = process.GetProcesses("\\" & childEntry.Name) 'tbxLog.Text &= childEntry.Name & vbNewLine & " - " & childEntry.Properties & " - " & childEntry.Username For Each a As PropertyAccess In childEntry.Properties ' tbxLog.Text &= PropertyAccess.Read.ToString Next ' childEntry.Properties. Try ' getProcess(childEntry) Catch ex As Exception End Try ' Timeout(5000, Shout()) ' MsgBox(childEntry.Name) ' If cnt > 10 Then Exit Sub ' cnt += 1 ' For Each a In childEntry.Properties ' Dim p As PropertyCollection() ' Next ' YLPS023046.verag.ost.dmn ' IsProcessRunning(childEntry.Name, "explorer.exe") End If ' Select Case childEntry.SchemaClassName ' Case "Domain" ' Dim SubChildEntry As DirectoryEntry 'Dim SubParentEntry As New DirectoryEntry 'SubParentEntry.Path = "WinNT://" & childEntry.Name 'For Each SubChildEntry In SubParentEntry.Children ' Select Case SubChildEntry.SchemaClassName 'Case "Computer" 'MsgBox(SubChildEntry.Name) 'ListView1.Items.Add(SubChildEntry.Name) 'End Select ' Next 'End Select Next MsgBox(str) Catch Excep As Exception MsgBox("Error While Reading Directories : " + Excep.Message.ToString) Finally ParentEntry = Nothing End Try End Sub Private Function getProcess(childEntry) As Boolean Dim progresses = Process.GetProcesses("\\" & childEntry.Name) MsgBox(progresses.Count) ' For i As Integer = 0 To progresses.Count - 1 'Dim p = progresses(i) 'tbxLog.Text = childEntry.Name & " - " & p.ProcessName & vbNewLine 'If p.ProcessName = "explorer" Then 'MsgBox(childEntry.Name) 'getProcess = True 'Exit For 'End If 'Next ' For Each p As Process In Process.GetProcesses("\\" & childEntry.Name) 'assuming you want to look for sqlserver process in each pc 'if found then you may add in list of computer ' MsgBox(p.ProcessName) 'tbxLog.Text = childEntry.Name & " - " & p.ProcessName & vbNewLine ' tbxLog.ScrollToCaret() ' If p.ProcessName = "explorer" Then 'MsgBox(childEntry.Name) ' getProcess = True ' Exit For ' End If ' If cnt > 10 Then Exit Sub ' cnt += 1 ' MsgBox(p.ProcessName) ' Next getProcess = False End Function Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click processlol() ' Dim remoteEDD1 As Process() = process.GetProcessesByName("QC", "comp1") ' If remoteEDD1.Length = 1 Then ' edd1.BackColor = Color.Red ' Else ' edd1.BackColor = Color.Green ' End If End Sub Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click test2() End Sub Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click GetAllUsers() End Sub Private Sub Button6_Click(sender As Object, e As EventArgs) Handles btnPDF.Click reafPdf() End Sub ' VB.NET version of 'Hello World' Sub Mainpdf() ' Create a new PDF document Dim document As PdfSharp.Pdf.PdfDocument = New PdfSharp.Pdf.PdfDocument document.Info.Title = "Created with PDFsharp" ' Create an empty page Dim page As PdfSharp.Pdf.PdfPage = document.AddPage ' Get an XGraphics object for drawing Dim gfx As XGraphics = XGraphics.FromPdfPage(page) ' Draw crossing lines Dim pen As XPen = New XPen(XColor.FromArgb(255, 0, 0)) gfx.DrawLine(pen, New XPoint(0, 0), New XPoint(page.Width.Point, page.Height.Point)) gfx.DrawLine(pen, New XPoint(page.Width.Point, 0), New XPoint(0, page.Height.Point)) ' Draw an ellipse gfx.DrawEllipse(pen, 3 * page.Width.Point / 10, 3 * page.Height.Point / 10, 2 * page.Width.Point / 5, 2 * page.Height.Point / 5) ' Create a font Dim font As XFont = New XFont("Verdana", 20, XFontStyle.Bold) ' Draw the text gfx.DrawString("Hello, World!", font, XBrushes.Black, New XRect(0, 0, page.Width.Point, page.Height.Point), XStringFormats.Center) ' Save the document... Dim filename As String = "HelloWorld.pdf" document.Save(filename) ' ...and start a viewer. Process.Start(filename) End Sub Sub fillpdf() 'Dim fileN4 As String = "test.pdf" ' File.Copy("C:\Users\DEVELOPER1\Desktop\test.pdf", Path.Combine(Directory.GetCurrentDirectory(), fileN4), True) ' Open the file Dim document As PdfSharp.Pdf.PdfDocument = PdfSharp.Pdf.IO.PdfReader.Open("C:\Users\DEVELOPER1\Desktop\test3.pdf", PdfDocumentOpenMode.Modify) Dim currentField As PdfTextField = document.AcroForm.Fields("Frächter") 'document.AcroForm.Fields. ' document.AcroForm.Fields. ' document.AcroForm.setGenerateAppearances = True 'const Dim caseName As String = "Frächter" Dim caseNamePdfStr As PdfSharp.Pdf.PdfString = New PdfSharp.Pdf.PdfString(caseName) 'set the value of this field currentField.ReadOnly = False currentField.Value = New PdfSharp.Pdf.PdfString("TEST") ' currentField.Text = "Jim Smith" 'Dim d As PDFEdit 'currentField.Text = New PdfTextField("TEST") 'Dim pdsad As PdfTextField 'pdsad.Value = New PdfItem("asd") ' Save the document... 'Dim stamp As New PdfStamper(reader, Response.OutputStream) document.Save("C:\Users\DEVELOPER1\Desktop\testTTT.pdf") End Sub Sub reafPdf() Dim cnt As Integer = 0 Try For Each file As String In System.IO.Directory.GetFiles("C:\Users\DEVELOPER1\Desktop\Verpfl\Fahrer_NCTS_Verpflichtungserklärungen\") ' Ermittelt alle Dateien des Ordners Try Dim pdf As itextsharp.text.pdf.PdfReader = New itextsharp.text.pdf.PdfReader(file) Dim stamper = New PdfStamper(pdf, New FileStream("C:\Users\DEVELOPER1\Desktop\Verpfl\tmp.pdf", FileMode.Create)) Dim f = stamper.AcroFields ' If MsgBox(f.GetField("Frächter"), vbYesNo) = vbYes Then Exit For ' MsgBox(f.GetField("LKW Kennzeichen")) ' MsgBox(f.GetField("Mobil Telefon")) ' MsgBox(f.GetField("Fahrername")) ' MsgBox(f.GetField("Pass Nummer")) ' MsgBox(f.GetField("Wohnadresse")) Dim sql = "INSERT INTO tblData " & "(fd_fraechter, fd_lkw, fd_fahrerName, fd_tel, fd_passNummer, fd_wohnAdresse) VALUES " & "(@fd_fraechter, @fd_lkw, @fd_fahrerName, @fd_tel, @fd_passNummer, @fd_wohnAdresse)" Dim cn As New SqlConnection() cn.ConnectionString = "Data Source=BUCHHALTUNG\SQLEXPRESS;Initial Catalog=FD;Integrated Security=false;User ID=sa;Password=BmWr501956;" cn.Open() Using cmd As New SqlCommand(sql, cn) cmd.Parameters.AddWithValue("@fd_fraechter", f.GetField("Frächter")) cmd.Parameters.AddWithValue("@fd_lkw", f.GetField("LKW Kennzeichen")) cmd.Parameters.AddWithValue("@fd_fahrerName", f.GetField("Fahrername")) cmd.Parameters.AddWithValue("@fd_tel", f.GetField("Mobil Telefon")) cmd.Parameters.AddWithValue("@fd_passNummer", f.GetField("Pass Nummer")) cmd.Parameters.AddWithValue("@fd_wohnAdresse", f.GetField("Wohnadresse")) Try cmd.ExecuteNonQuery() cnt += 1 Catch ex As Exception MsgBox(System.Reflection.MethodInfo.GetCurrentMethod.Name & ": Datensatz kann nicht gespeichert werden!" & vbCrLf & vbCrLf & ex.Message, vbExclamation, "Fehler beim Speichern Data") End Try End Using cn.Close() stamper.Close() pdf.Close() Catch ex As Exception My.Computer.FileSystem.CopyFile(file, "C:\Users\DEVELOPER1\Desktop\Verpfl\Fahrer_NCTS_Verpflichtungserklärungen\noCopy\" & cut_file(file)) End Try Next Catch ex As Exception MsgBox(System.Reflection.MethodInfo.GetCurrentMethod.Name & ": Datensatz kann nicht gespeichert werden!" & vbCrLf & vbCrLf & ex.Message, vbExclamation, "Fehler beim Speichern Data") End Try MsgBox(cnt & " eingefügt") 'My.Computer.FileSystem.DeleteFile("C:\Users\DEVELOPER1\Desktop\Verpfl\tmp.pdf") End Sub Private Function cut_file(ByVal file As String) As String ' Funktion zum Entfernen der Backslashs / Ordner While file.Contains("\") file = file.Remove(0, 1) End While Return file End Function While file.Contains("\") file = file.Remove(0, 1) End While Return file End Function Sub pdf2() Dim pdf As itextsharp.text.pdf.PdfReader = New itextsharp.text.pdf.PdfReader("C:\Users\DEVELOPER1\Desktop\Verpfl\test.pdf") Using fw As New FileStream("C:\Users\DEVELOPER1\Desktop\Verpfl\tmp.pdf", FileMode.Open) Dim stamper = New PdfStamper(pdf, fw) Dim f = stamper.AcroFields 'f.GenerateAppearances = True 'f.SetField("Frächter", "John Doe") MsgBox(f.GetField("Frächter")) stamper.FormFlattening = True stamper.Close() End Using pdf.Close() End Sub Private Sub Button6_Click_1(sender As Object, e As EventArgs) Handles Button6.Click Try Dim sql = "SELECT TOP 1 from Aviso" Dim cn As New SqlConnection() 'cn.ConnectionString = "Data Source=172.16.0.98\VERAG-ATILLA2;Network Library=DBMSSOCN;Initial Catalog=AVISO_ATILLA;Integrated Security=false;User ID=VERAG-NCTS\Administrator;Password=wassermann;" cn.ConnectionString = "Data Source=172.16.0.98;Initial Catalog=AVISO_ATILLA;Integrated Security=false;User ID=sa;Password=BmWr501956;" '\VERAG-ATILLA2 Try cn.Open() MsgBox("Connection Open!!!!!!!!!!!!!!!!!!!!!!!!! ! ") cn.Close() Catch ex As Exception MsgBox("Can not open connection ! ") End Try cn.Close() Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub TabPage1_Click(sender As Object, e As EventArgs) Handles TabPage1.Click End Sub Private Sub btnMail_Click(sender As Object, e As EventArgs) Handles btnMail.Click Dim Msg As New System.Net.Mail.MailMessage Dim myCredentials As New System.Net.NetworkCredential myCredentials.UserName = "al@verag.ag" myCredentials.Password = "Luxandreas#2" Msg.IsBodyHtml = True Dim mySmtpsvr As New SmtpClient() mySmtpsvr.Host = "smtp.1und1.de" 'bei web.de mySmtpsvr.Port = 25 mySmtpsvr.UseDefaultCredentials = False mySmtpsvr.Credentials = myCredentials Try Msg.From = New MailAddress("al@verag.ag") Msg.To.Add("al@verag.ag") Msg.Subject = "Zollamt Waidhaus" Msg.Body = GetEmailBody() mySmtpsvr.Send(Msg) MsgBox("E-Mail gesendet.", MsgBoxStyle.Information, Title:="Information") Catch ex As Exception MsgBox(Err.Number & ex.Message & ex.StackTrace.ToString) 'Falls ein Fehler auftritt wird eine MsgBox angezeigt End Try End Sub Private Function GetEmailBody() As String Dim Str As String = "" Str += "

" Str += "Sehr geehrte Damen und Herren!" & "
" Str += "
" Str += "Das ist ein Test!" & "
" Str += "
" Str += "
" Str += "

" Str += "

" Str += "Mit freundlichen Grüßen" & "
" Str += "Andreas Luxbauer" & "
" Str += "
" Str += "
" Str += "VERAG Spedition AG" & "
" Str += "A 4975 Suben 100" & "
" Str += "
" Str += "T   +43 7711 2777-35" & "
" Str += "F   +43 7711 2777-28" & "
" Str += "@   al@verag.ag" & "
" Str += " www.verag.ag" & "
" Str += "
" Str += "
" Str += "" Str += "
" Str += "
" Str += "Diese E-Mail enthält vertrauliche und/oder rechtlich geschützte Informationen." & "
" Str += "Wenn Sie nicht der richtige Adressat sind oder diese E-Mail irrtümlich erhalten haben, informieren Sie bitte sofort den Absender und vernichten Sie diese E-Mail." & vbNewLine Str += "Vielen Dank." & "
" Str += "Das unerlaubte Kopieren sowie die unbefugte Weitergabe dieser E-Mail ist nicht gestattet." & "
" Str += "This e-mail contains confidential and/or privileged information." & "
" Str += "If you are not the intended recipient (or have received this e-mail in error)" & "
" Str += "please notify the sender and delete this message." & "
" Str += "Thank you." & "
" Str += "Any unauthorized copying, disclosure or distribution of the material in this e-mail is strictly forbidden." Str += "

" Return Str End Function Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click ' genExcel() 'Exit Sub 'System.IO.FileSystemWatcher() Try Using sr As New StreamReader("C:\Users\DEVELOPER1\Desktop\AECB303182") Dim line As String = "" Dim rowcnt = 1 Do While sr.Peek() >= 0 line = CStr(sr.ReadLine()) ' Console.WriteLine(line) ' MsgBox(line) Dim cnt = 0 Dim s = line.Split(Chr(29)) If s(0) = "CPS" Then MsgBox(s(14)) MsgBox(s(15)) MsgBox(s(16)) End If rowcnt += 1 Loop End Using Catch ex As Exception Console.WriteLine("The file could not be read:") MsgBox(ex.Message) End Try Exit Sub Try Using sr As New StreamReader("C:\Users\DEVELOPER1\Desktop\AECB303182") Dim line As String = "" line = sr.ReadToEnd() Console.WriteLine(line) For Each i In line.Split(Chr(29)) MsgBox(i) Next End Using Catch ex2 As Exception Console.WriteLine("The file could not be read:") Console.WriteLine(ex2.Message) End Try End Sub Private Sub genExcel() Dim str As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 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) With exclApp .Visible = True Datei = .Workbooks.Open(Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\Test.xls") 'Anpassen Blatt = Datei.Worksheets("Tabelle1") 'Anpassen Try Using sr As New StreamReader("C:\Users\DEVELOPER1\Desktop\AECB303182") Dim line As String = "" Dim rowcnt = 1 Do While sr.Peek() >= 0 line = CStr(sr.ReadLine()) ' Console.WriteLine(line) ' MsgBox(line) Dim cnt = 0 For Each s In line.Split(Chr(29)) ' MsgBox(str(cnt) & rowcnt & "" & s) If cnt < 25 Then Blatt.Range(str(cnt) & rowcnt).Value = s cnt += 1 Next rowcnt += 1 Loop End Using Catch ex As Exception Console.WriteLine("The file could not be read:") MsgBox(ex.Message) End Try End With End Sub Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click ' Dim WordApp As Word.Application Dim WordDoc As Object ' Dim SQLSttmnt As String = "Select * From rechner WHERE ID=5360" Dim WordApp As Object WordApp = CreateObject("word.Application") WordDoc = CreateObject("word.Document") WordApp.Visible = True WordDoc = WordApp.Documents.Open("C:\Users\DEVELOPER1\Desktop\test\Erstattungsschreiben DE.doc") WordDoc.MailMerge.MainDocumentType = Word.WdMailMergeMainDocType.wdFormLetters WordDoc.MailMerge.OpenDataSource(Name:="", Connection:="DSN=dbConn_DEVELOPER;DATABASE=VERAG;uid=sa;pwd=BmWr501956;", SQLStatement:="SELECT * FROM vwUstRueckerstattung ", SubType:=Microsoft.Office.Interop.Word.WdMergeSubType.wdMergeSubTypeWord2000) 'Provider=SQLOLEDB;Server=DEVELOPER\DEVSQL;Database=VERAG;uid=sa;Password=BmWr501956; ' With WordDoc.MailMerge ' '.Destination = Word.WdMailMergeDestination.wdSendToPrinter ' .SuppressBlankLines = True ' With .DataSource ' .FirstRecord = Word.WdMailMergeDefaultRecord.wdDefaultFirstRecord '.LastRecord = Word.WdMailMergeDefaultRecord.wdDefaultLastRecord ' End With ' .Execute(Pause:=False) ' End With ' WordDoc.Close() End Sub Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click ' Dim c As New cFileSystemWatcher() cFileSystemWatcher.Main() End Sub Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click Try Dim datum As Date = Now.AddMonths(-6) While datum < DateTime.Now Dim sql = "SELECT count(AvisoID) from Aviso where Grenzstelle='SUB' AND Datum between '" & datum.ToShortDateString & " 00:00:00' and '" & datum.ToShortDateString & " 23:59:59' " Dim dr As SqlDataReader Dim cn As New SqlConnection() cn.ConnectionString = "Data Source=SQLGUIDE01.verag.ost.dmn;Initial Catalog=AVISO;Integrated Security=false;User ID=sa;Password=BmWr501956;" cn.Open() Using cmd As New SqlCommand(sql, cn) dr = cmd.ExecuteReader() Try Dim cnt As Integer = 0 While dr.Read DataGridView1.Rows.Add(datum.ToShortDateString(), dr.Item(0)) ' MsgBox(dr.Item(0)) End While ' Return daten Catch ex As Exception MsgBox(System.Reflection.MethodInfo.GetCurrentMethod.Name & ": Fehler mit der Datenbankverbindung:" & vbCrLf & vbCrLf & ex.Message, vbExclamation, "Datenbankfehler") Finally dr.Close() End Try End Using cn.Close() datum = datum.AddDays(1) ' Return Nothing End While Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click Dim s(17, 2) As String Dim t As String = Button11.Text Dim datVon As Date = CDate(txtdatVon.Value) Dim datBis As Date = CDate(txtdatBis.Value) Dim TESTgesLKWs = 0 Dim TESTgesLKWs2 = 0 Dim c As Integer = 0 For i = 6 To 22 Dim cnt As Integer = 0 Dim gesLKWs As Integer = 0 Dim datTmp As Date = datVon While datTmp <= datBis ' MsgBox(cboTag.SelectedIndex) If datTmp.DayOfWeek = cboTag.SelectedIndex Then Try Dim cn As New SqlConnection() cn.ConnectionString = "Data Source=SQLGUIDE01.verag.ost.dmn;Initial Catalog=AVISO;Integrated Security=false;User ID=sa;Password=BmWr501956;" cn.Open() Using cmd As New SqlCommand("SELECT COUNT(*) FROM DYIMPORT.AVISO]. DYIMPORT.dbo]. DYIMPORT.Aviso] where DYIMPORT.Ankunft] between @DatVon and @DatBis and Grenzstelle='SUB'", cn) 'DATEADD(dd, 0, DATEDIFF(dd, 0, DYIMPORT.Ankunft]))=DATEADD(dd, 0, DATEDIFF(dd, 0, DYIMPORT.Freigabe])) AND Dim VonStr = "" Dim BisStr = "" If i = 6 Then VonStr = datTmp.ToString("yyyy-MM-dd ") & "00:00:00" Else VonStr = datTmp.ToString("yyyy-MM-dd ") & i & ":00:00" End If If i = 22 Then BisStr = datTmp.ToString("yyyy-MM-dd ") & "23:59:59" Else BisStr = datTmp.ToString("yyyy-MM-dd ") & i & ":59:59" End If cmd.Parameters.AddWithValue("@DatVon", VonStr) cmd.Parameters.AddWithValue("@DatBis", BisStr) ' MsgBox(VonStr) Dim dr = cmd.ExecuteReader() Dim cPF As New cProgramFunctions If dr.HasRows Then dr.Read() gesLKWs += CInt(dr.Item(0)) TESTgesLKWs2 += CInt(dr.Item(0)) ' MsgBox(datTmp.ToString("yyyy-MM-dd ") & i & ":00:00" & ": " & CInt(dr.Item(0))) End If dr.Close() cn.Close() End Using Catch ex As Exception MsgBox(ex.Message) End Try cnt += 1 End If datTmp = datTmp.AddDays(1) End While ' Dim d As New Date(Year, i + 1, 1) ' s(i, 0) = d.ToString("MMM") ' s(i, 1) = CStr(Sql.getAVG(d, d.AddMonths(1).AddDays(-1), txtAuswJahrDauerVon.Text, txtAuswJahrDauerBis.Text)) s(c, 0) = i & ":00" ' MsgBox((gesLKWs & " - " & cnt)) If gesLKWs > 0 And cnt > 0 Then s(c, 1) = CInt(gesLKWs / cnt) Else s(c, 1) = 0 End If ' MsgBox("s: " & s(c, 1)) c += 1 ' Label2.Text = (CInt(c / 0.17) & " %") Next Panel1_Paint(s) Button11.Text = t End Sub Private Sub Panel1_Paint(s(,) As String) 'Handles Panel1.Paint Dim g As Graphics = Panel1.CreateGraphics g.Clear(Color.FromArgb(245, 245, 245)) Dim p As Panel = Panel1 'Jahre: Dim topbound = 10 Dim y0 As Integer = 0 Dim x0 As Integer = 0 Dim yMax As Integer = p.Height - 50 Dim xMax As Integer = p.Width Dim h As Integer = p.Height Dim w As Integer = p.Width ' MsgBox(s(i, 0) & " - " & s(i, 1)) Dim sMax As Long = getMax(s) Dim xLeftBound As Integer = 0 For i = 0 To s.GetUpperBound(0) - 1 Dim hoehe = 0 If sMax > 0 Then hoehe = CInt(yMax * (CLng(s(i, 1)) * 100 / sMax) / 100) ' MsgBox(hoehe) ' g.FillRectangle(Brushes.Red, New Rectangle(x0 + xLeftBound, y0, 20, hoehe)) g.FillRectangle(Brushes.Red, CoordRectangle(w, h, x0 + xLeftBound, y0 + 20, 20, hoehe)) g.DrawString(CInt(s(i, 1)).ToString, p.Font, Brushes.Black, CoordPoint(h, x0 + xLeftBound, 20 + hoehe + 15)) g.DrawString(CStr(s(i, 0)).ToString, p.Font, Brushes.Black, CoordPoint(h, x0 + xLeftBound, 15)) xLeftBound += 30 Next End Sub Function getMax(s(,) As String) As Long Dim max As Long = 0 For i = 0 To s.GetUpperBound(0) - 1 If CLng(s(i, 1)) > max Then max = CLng(s(i, 1)) End If Next Return max End Function Function CoordRectangle(w As Integer, h As Integer, x0 As Integer, y0 As Integer, x As Integer, y As Integer) As Rectangle ' MsgBox(" x0: " & x0 & " y0: " & CStr(h - y0 - y) & " x: " & x & " y: " & y) Return New Rectangle(x0, h - y0 - y, x, y) End Function Function CoordPoint(h As Integer, x As Integer, y As Integer) As Point Return New Point(x, h - y) End Function Private Function GetFormImage(ByVal include_borders As _ Boolean) As Bitmap ' Make the bitmap. Dim wid As Integer = Me.Width Dim hgt As Integer = Me.Height Dim bm As New Bitmap(wid, hgt) ' Draw the form onto the bitmap. Me.DrawToBitmap(bm, New Rectangle(0, 0, wid, hgt)) ' If we want the borders, return the bitmap. If include_borders Then Return bm ' Make a smaller bitmap without borders. wid = Me.ClientSize.Width hgt = Me.ClientSize.Height Dim bm2 As New Bitmap(wid, hgt) ' Get the offset from the window's corner to its client ' area's corner. Dim pt As New Point(0, 0) pt = PointToScreen(pt) Dim dx As Integer = pt.X - Me.Left Dim dy As Integer = pt.Y - Me.Top ' Copy the part of the original bitmap that we want ' into the bitmap. Dim gr As Graphics = Graphics.FromImage(bm2) gr.DrawImage(bm, 0, 0, New Rectangle(dx, dy, wid, hgt), GraphicsUnit.Pixel) Return bm2 End Function Private Function TakeScreenShot(ByVal Control As Control) As Bitmap Dim tmpImg As New Bitmap(Control.Width, Control.Height) Using g As Graphics = Graphics.FromImage(tmpImg) g.CopyFromScreen(Control.PointToScreen(New Point(0, 0)), New Point(0, 0), New Size(Control.Width, Control.Height)) End Using Return tmpImg End Function Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click Dim i As Image = TakeScreenShot(Panel1) If Not My.Computer.FileSystem.DirectoryExists(My.Computer.FileSystem.SpecialDirectories.Desktop & "\STAT\") Then My.Computer.FileSystem.CreateDirectory(My.Computer.FileSystem.SpecialDirectories.Desktop & "\STAT\") End If Dim s As String = My.Computer.FileSystem.SpecialDirectories.Desktop & "\STAT\Stat_" & cboTag.Text & "_" & txtdatVon.Value.ToShortDateString & "_" & txtdatBis.Value.ToShortDateString & " .png" i.Save(s, Drawing.Imaging.ImageFormat.Png) End Sub Private Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Click Dim cDgvToExcel As New cDgvToExcel cDgvToExcel.start(DataGridView1) End Sub Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click 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 Exit Sub If result = System.Windows.Forms.DialogResult.OK Then ' MsgBox("start0") 'lblOpen.Visible = True 'Label1.Visible = True ' Button1.Enabled = False 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 ' exclApp = CreateObject("Excel.Application") With exclApp Try ' .Visible = False ' Dim GuiId As String = System.Guid.NewGuid().ToString().ToUpper() ' exclApp.Caption = GuiId exclApp.CutCopyMode = 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 For index = 1 To Blatt.UsedRange.Rows.Count ' MsgBox(Blatt.Range("C" & index).Value) Dim valueX As String = "" Try valueX = Blatt.Range("C" & index).Value.ToString Catch ex As Exception End Try If valueX = "X" Then ' MsgBox("A") Try Dim sql = "DELETE FROM Firmen WHERE FirmaID = '" & Blatt.Range("A" & index).Value.ToString & "'" Dim cn As New SqlConnection() cn.ConnectionString = "Data Source=SQLGUIDE01.verag.ost.dmn;Initial Catalog=AVISO;Integrated Security=false;User ID=sa;Password=BmWr501956;" cn.Open() Using cmd As New SqlCommand(sql, cn) Try cmd.ExecuteNonQuery() ' cnt += 1 Catch ex As Exception MsgBox(System.Reflection.MethodInfo.GetCurrentMethod.Name & ": Datensatz kann nicht gespeichert werden!" & vbCrLf & vbCrLf & ex.Message, vbExclamation, "Fehler beim Speichern Data") End Try End Using cn.Close() Catch ex As Exception MsgBox(ex.Message) End Try End If Next MsgBox("FIN") Catch ex As Exception MsgBox("ERR" & ex.Message) End Try End With End If Me.Cursor = Cursors.Default End Sub Private Sub ButtonEmail_Click(sender As Object, e As EventArgs) Handles ButtonEmail.Click Dim Msg As New MailMessage Dim myCredentials As New System.Net.NetworkCredential myCredentials.UserName = "al@verag.ag" myCredentials.Password = "Luxandreas#2" Msg.IsBodyHtml = False Dim mySmtpsvr As New SmtpClient() mySmtpsvr.Host = "smtp.1und1.de" 'bei web.de mySmtpsvr.Port = 587 '25 mySmtpsvr.UseDefaultCredentials = False mySmtpsvr.Credentials = myCredentials Try Msg.From = New MailAddress("al@verag.ag") Msg.To.Add("al@verag.ag") Msg.Subject = "Betreff" Msg.Body = "Inhalt" mySmtpsvr.Send(Msg) MsgBox("E-Mail gesendet.", MsgBoxStyle.Information, Title:="Information") Catch ex As Exception MsgBox(Err.Number & ex.Message & ex.StackTrace.ToString) 'Falls ein Fehler auftritt wird eine MsgBox angezeigt End Try End Sub Private Sub ButtonWebservice_Click(sender As Object, e As EventArgs) Handles ButtonWebservice.Click Dim bline As Byte() Dim str(2) As String Dim xml As String 'CHANGE HERE use the real path of the pdf physical path here. ' bline = System.IO.File.ReadAllBytes("C:\Users\DEVELOPER1\Desktop\sample.pdf") '' str(0) = (Convert.ToBase64String(System.IO.File.ReadAllBytes("C:\Users\DEVELOPER1\Desktop\sample.pdf"))) ' str(1) = (Convert.ToBase64String(System.IO.File.ReadAllBytes("C:\Users\DEVELOPER1\Desktop\sample2.pdf"))) ' Dim strt As New ArrayOfString() ' Dim xml_serializer As New XmlSerializer(GetType(List(Of Files))) ' Dim string_writer As New StringWriter ' xml_serializer.Serialize(string_writer, p) Dim myTypeMapping As XmlTypeMapping = (New SoapReflectionImporter().ImportTypeMapping(GetType(Files))) Dim string_writer As New StringWriter() Dim mySerializer As XmlSerializer = New XmlSerializer(myTypeMapping) mySerializer.Serialize(string_writer, New Files(Convert.ToBase64String(System.IO.File.ReadAllBytes("C:\Users\DEVELOPER1\Desktop\sample.pdf")))) Console.ReadLine() ' txtSerialization.Text = string_writer.ToString() Dim a As Array xml = " " & " " & "" & "sample.pdf" & "" & string_writer.ToString & "" & "" & "" ' ' string_writer.Close() MsgBox(xml) Dim data As String = xml Dim url As String = "http://localhost:64588/wsGetBrgData.asmx" Dim responsestring As String = "" Dim myReq As HttpWebRequest = WebRequest.Create(url) Dim proxy As IWebProxy = CType(myReq.Proxy, IWebProxy) Dim proxyaddress As String Dim myProxy As New WebProxy() Dim encoding As New ASCIIEncoding Dim buffer() As Byte = encoding.GetBytes(xml) Dim response As String myReq.AllowWriteStreamBuffering = False myReq.Method = "POST" myReq.ContentType = "text/xml; charset=UTF-8" myReq.ContentLength = buffer.Length myReq.Headers.Add("SOAPAction", "http://tempuri.org/SaveIncomingFile") 'SOAPAction myReq.Credentials = New NetworkCredential("abc", "123") myReq.PreAuthenticate = True proxyaddress = proxy.GetProxy(myReq.RequestUri).ToString Dim newUri As New Uri(proxyaddress) myProxy.Address = newUri myReq.Proxy = myProxy Dim post As Stream = myReq.GetRequestStream post.Write(buffer, 0, buffer.Length) post.Close() ' MsgBox(myReq) Dim myResponse As HttpWebResponse = myReq.GetResponse Dim responsedata As Stream = myResponse.GetResponseStream Dim responsereader As New StreamReader(responsedata) response = responsereader.ReadToEnd MsgBox(response) End Sub Class InputXmlFileRequest Public xmlInputData As String End Class Private Sub Button15_ClickSaveSimpleIncomingFile(sender As Object, e As EventArgs) Handles Button15.Click 'Dim bline As Byte() Dim str As String Dim xml As String 'CHANGE HERE use the real path of the pdf physical path here. 'bline = System.IO.File.ReadAllBytes("C:\Users\DEVELOPER1\Desktop\sample.pdf") str = (Convert.ToBase64String(System.IO.File.ReadAllBytes("C:\Users\DEVELOPER1\Desktop\sample.pdf"))) xml = " " & " " & "" & "sample.pdf" & "" & str & "" & "" & "" ' ' string_writer.Close() MsgBox(xml) Dim data As String = xml Dim url As String = "http://localhost:64588/wsGetBrgData.asmx" Dim responsestring As String = "" Dim myReq As HttpWebRequest = WebRequest.Create(url) Dim proxy As IWebProxy = CType(myReq.Proxy, IWebProxy) Dim proxyaddress As String Dim myProxy As New WebProxy() Dim encoding As New ASCIIEncoding Dim buffer() As Byte = encoding.GetBytes(xml) Dim response As String myReq.AllowWriteStreamBuffering = False myReq.Method = "POST" myReq.ContentType = "text/xml; charset=UTF-8" myReq.ContentLength = buffer.Length myReq.Headers.Add("SOAPAction", "http://tempuri.org/SaveSimpleIncomingFile") 'SOAPAction myReq.Credentials = New NetworkCredential("abc", "123") myReq.PreAuthenticate = True proxyaddress = proxy.GetProxy(myReq.RequestUri).ToString Dim newUri As New Uri(proxyaddress) myProxy.Address = newUri myReq.Proxy = myProxy Dim post As Stream = myReq.GetRequestStream post.Write(buffer, 0, buffer.Length) post.Close() ' MsgBox(myReq) Dim myResponse As HttpWebResponse = myReq.GetResponse Dim responsedata As Stream = myResponse.GetResponseStream Dim responsereader As New StreamReader(responsedata) response = responsereader.ReadToEnd MsgBox(response) End Sub Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click Dim fd As New OpenFileDialog fd.Filter = "TXT Dateien|*.txt;*.TXT" Dim result As DialogResult = fd.ShowDialog() If Not fd.FileName.EndsWith(".txt") And Not fd.FileName.EndsWith(".TXT") Then MsgBox("Falsche Datei") Exit Sub End If Dim cSqlDb As New cSqlDb Try If result = System.Windows.Forms.DialogResult.OK Then Dim sr As New System.IO.StreamReader(fd.FileName) Dim s As String = "" Dim cnt = 0 While sr.Peek > -1 s = sr.ReadLine() Dim sql = "UPDATE DYIMPORT.Adressen] " & " SET DYIMPORT.Auswahl]='I' " & " WHERE DYIMPORT.AdressenNr] = @kdnr" Dim cn As New SqlConnection() cn.ConnectionString = My.Resources.connStringFMZOLL cn.Open() Using cmd As New SqlCommand(sql, cn) cmd.Parameters.AddWithValue("@kdnr", s.Trim) Try cmd.ExecuteNonQuery() Catch ex As Exception MsgBox(System.Reflection.MethodInfo.GetCurrentMethod.Name & ": Datensatz kann nicht gespeichert werden: " & s.Trim & vbCrLf & vbCrLf & ex.Message, vbExclamation, "Fehler beim Speichern Data") End Try End Using cn.Close() cnt += 1 If cnt.ToString.EndsWith("000") Then MsgBox(cnt) End If End While sr.Close() End If Catch ex As Exception MsgBox(ex.Message) End Try MessageBox.Show("END") Me.Cursor = Cursors.Default End Sub Private Sub Button17_Click(sender As Object, e As EventArgs) Handles Button17.Click DAKOSY_Worker.cIMPORT_Codelisten.IMPORT("C0008", True) 'VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM) End Sub Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL Private Sub Button18_Click(sender As Object, e As EventArgs) Handles Button18.Click Dim StartZeit As Date = DateTime.Now Dim StopZeit As Date = DateTime.Now If Not IsNumeric(TextBox1.Text) Then Exit Sub Dim test = VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = CheckBox1.Checked Dim cnt = 1 'dim listAVISO = New List(Of cAviso) Dim sql As New VERAG_PROG_ALLGEMEIN.SQL Dim dt As DataTable = sql.loadDgvBySql(" SELECT TOP (" & CInt(TextBox1.Text) & ") * FROM DYIMPORT.AVISO_ATILLA]. DYIMPORT.dbo]. DYIMPORT.Aviso] WHERE Importiert=0 order by Avisoid ", "AVISO_ATILLA") ' ' My.MySettings.Default.AVISO_ATILLAConnectionString For Each r As DataRow In dt.Rows Dim NEWAVISOID = (SpeichernAviso(r)) Dim dtAenderungen As DataTable = sql.loadDgvBySql(" SELECT * FROM DYIMPORT.AVISO_ATILLA]. DYIMPORT.dbo]. DYIMPORT.Aenderungen] WHERE Avisoid='" & r("AvisoID") & "'", "AVISO_ATILLA") For Each r2 As DataRow In dtAenderungen.Rows addAenderung(NEWAVISOID, r2) Next Dim dtVermerke As DataTable = sql.loadDgvBySql(" SELECT * FROM DYIMPORT.AVISO_ATILLA]. DYIMPORT.dbo]. DYIMPORT.Vermerke] WHERE Avisoid='" & r("AvisoID") & "'", "AVISO_ATILLA") For Each r2 As DataRow In dtVermerke.Rows SpeichernVermerk(NEWAVISOID, r2) Next sql.doSQL(" UPDATE DYIMPORT.AVISO_ATILLA]. DYIMPORT.dbo]. DYIMPORT.Aviso] SET Importiert=1 WHERE Avisoid='" & r("AvisoID") & "'", "AVISO_ATILLA") ' IMPORTIERT Setzen If cnt Mod 5 = 0 Then Label3.Text = cnt & "/" & TextBox1.Text StopZeit = DateTime.Now Label4.Text = GetTimeInterval(DateDiff(DateInterval.Second, StartZeit, StopZeit)) Me.Refresh() End If cnt += 1 Next VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = test End Sub 'exec atlas.dbo.kundenstamm @ndl = 'SUB'; Private Function GetTimeInterval(ByVal nSeks As Long) As String Dim h As Long, m As Long Dim sInterv As String h = nSeks \ 3600 nSeks = nSeks Mod 3600 m = nSeks \ 60 nSeks = nSeks Mod 60 sInterv = Format(h, "00") & ":" & Format(m, "00") & ":" & Format(nSeks, "00") GetTimeInterval = sInterv End Function Public Sub addAenderung(NEWAVISOID As Integer, ByVal r As DataRow) Dim hAuswahl As String = " INSERT INTO Aenderungen " & " ( DYIMPORT.AvisoID], DYIMPORT.Datum], DYIMPORT.Mitarbeiter], DYIMPORT.MitarbeiterId], DYIMPORT.Aenderung_Art], DYIMPORT.Aenderung_Text]) " & " VALUES (@AvisoID, @Datum, @Mitarbeiter, @MitarbeiterId, @Aenderung_Art, @Aenderung_Text)" Dim sql = hAuswahl Dim conn As SqlConnection = VERAG_PROG_ALLGEMEIN.SQL.GetNewOpenConnectionAVISO() Using cmd As New SqlCommand(sql, conn) cmd.Parameters.AddWithValue("@AvisoID", NEWAVISOID) cmd.Parameters.AddWithValue("@Datum", r("Datum")) cmd.Parameters.AddWithValue("@Mitarbeiter", r("Mitarbeiter")) cmd.Parameters.AddWithValue("@MitarbeiterId", r("MitarbeiterId")) cmd.Parameters.AddWithValue("@Aenderung_Art", r("Aenderung_Art")) cmd.Parameters.AddWithValue("@Aenderung_Text", r("Aenderung_Text")) Try cmd.ExecuteNonQuery() Catch ex As SqlException MsgBox("Datensatz kann nicht gespeichert werden!" & vbCrLf & vbCrLf & ex.Message, vbExclamation, "Fehler beim Speichern Aenderungen") End Try End Using conn.Close() End Sub Public Sub SpeichernVermerk(NEWAVISOID As Integer, ByVal r As DataRow) Dim hAuswahl As String hAuswahl = "INSERT INTO Vermerke " & "(AvisoID,VermerkArt,SendungID, Datum, Mitarbeiter, Hinweis_Vermerk, VermerkeCode,MitarbeiterId,Beschreibung) VALUES (@AvisoID,@VermerkArt, @SendungID, @Datum, @Mitarbeiter, @Hinweis_Vermerk, @VermerkeCode,@MitarbeiterId,@Beschreibung)" Dim sql = hAuswahl Dim conn As SqlConnection = VERAG_PROG_ALLGEMEIN.SQL.GetNewOpenConnectionAVISO() Using cmd As New SqlCommand(sql, conn) cmd.Parameters.AddWithValue("@AvisoID", NEWAVISOID) cmd.Parameters.AddWithValue("@Datum", r("Datum")) cmd.Parameters.AddWithValue("@Mitarbeiter", r("Mitarbeiter")) cmd.Parameters.AddWithValue("@Hinweis_Vermerk", r("Hinweis_Vermerk")) 'cmd.Parameters.AddWithValue("@VermerkID", r("VermerkID")) cmd.Parameters.AddWithValue("@VermerkeCode", r("VermerkeCode")) cmd.Parameters.AddWithValue("@MitarbeiterId", r("MitarbeiterId")) cmd.Parameters.AddWithValue("@Beschreibung", r("Beschreibung")) cmd.Parameters.AddWithValue("@VermerkArt", r("VermerkArt")) cmd.Parameters.AddWithValue("@SendungID", r("SendungID")) Try cmd.ExecuteNonQuery() Catch ex As SqlException MsgBox("Datensatz kann nicht gespeichert werden!" & vbCrLf & vbCrLf & ex.Message, vbExclamation, "Fehler beim Speichern Vermerk") End Try End Using conn.Close() End Sub Public Function SpeichernAviso(ByVal r As DataRow) As Integer Dim hAuswahl As String Dim id As Integer = -1 'Neuanlage hAuswahl = "INSERT INTO Aviso " & "(Datum, LKW_Nr, Telefonisch, Änderungen, Info, Status, Auftraggeber, Frächter, letzterMitarbeiter, " & "Vorbereitet,Vorgeschrieben, Ankunft, Freigabe, Dauer, AvisoEingang, Grenzstelle, LKW_fertig,letzterMitarbeiterId,Handling,Sendungen_Gesamtanzahl,Sammelakt,Frächter_KdNr,Auftraggeber_KdNr,AvisoTVHinweis,Buero,Imex,Abgeschlossen,FIRMA) VALUES (" & "@Datum, @LKW_Nr, @Telefonisch, @Änderungen, @Info, @Status, @Auftraggeber, @Frächter, @letzterMitarbeiter, " & "@Vorbereitet, @Vorgeschrieben, @Ankunft, @Freigabe, @Dauer, @AvisoEingang, @Grenzstelle, @LKW_fertig,@letzterMitarbeiterId,@Handling,@Sendungen_Gesamtanzahl,@Sammelakt,@Frächter_KdNr,@Auftraggeber_KdNr,@AvisoTVHinweis,@Buero,@Imex,@Abgeschlossen,@FIRMA); SELECT CAST(scope_identity() AS int);" Dim sql = hAuswahl Dim conn As SqlConnection = VERAG_PROG_ALLGEMEIN.SQL.GetNewOpenConnectionAVISO Using cmd As New SqlCommand(sql, conn) cmd.Parameters.AddWithValue("@Datum", r("Datum")) cmd.Parameters.AddWithValue("@LKW_Nr", r("LKW_Nr")) cmd.Parameters.AddWithValue("@Telefonisch", r("Telefonisch")) cmd.Parameters.AddWithValue("@Änderungen", r("Änderungen")) cmd.Parameters.AddWithValue("@Info", r("Info")) cmd.Parameters.AddWithValue("@Status", r("Status")) cmd.Parameters.AddWithValue("@Auftraggeber", r("Auftraggeber")) cmd.Parameters.AddWithValue("@Frächter", r("Frächter")) cmd.Parameters.AddWithValue("@letzterMitarbeiter", r("letzterMitarbeiter")) cmd.Parameters.AddWithValue("@Vorbereitet", r("Vorbereitet")) cmd.Parameters.AddWithValue("@Vorgeschrieben", r("Vorgeschrieben")) cmd.Parameters.AddWithValue("@Ankunft", r("Ankunft")) cmd.Parameters.AddWithValue("@Freigabe", r("Freigabe")) cmd.Parameters.AddWithValue("@Dauer", r("Dauer")) cmd.Parameters.AddWithValue("@AvisoEingang", r("AvisoEingang")) cmd.Parameters.AddWithValue("@Grenzstelle", r("Grenzstelle")) cmd.Parameters.AddWithValue("@LKW_fertig", r("LKW_fertig")) 'cmd.Parameters.AddWithValue("@AvisoID",r("AvisoID")) cmd.Parameters.AddWithValue("@letzterMitarbeiterId", r("letzterMitarbeiterId")) cmd.Parameters.AddWithValue("@Handling", r("Handling")) cmd.Parameters.AddWithValue("@Sendungen_Gesamtanzahl", r("Sendungen_Gesamtanzahl")) cmd.Parameters.AddWithValue("@Sammelakt", r("Sammelakt")) cmd.Parameters.AddWithValue("@Auftraggeber_KdNr", r("Auftraggeber_KdNr")) cmd.Parameters.AddWithValue("@Frächter_KdNr", r("Frächter_KdNr")) cmd.Parameters.AddWithValue("@AvisoTVHinweis", If(r("AvisoTVHinweis") Is DBNull.Value, "", r("AvisoTVHinweis"))) cmd.Parameters.AddWithValue("@Buero", r("Buero")) cmd.Parameters.AddWithValue("@Imex", r("ImEx")) cmd.Parameters.AddWithValue("@Abgeschlossen", r("Abgeschlossen")) cmd.Parameters.AddWithValue("@FIRMA", r("FIRMA")) Try id = (Convert.ToInt32(cmd.ExecuteScalar())) Catch ex As SqlException MsgBox("Datensatz kann nicht gespeichert werden!" & vbCrLf & vbCrLf & ex.Message, vbExclamation, "Fehler beim Speichern Aviso") End Try End Using conn.Close() Return id End Function Public Shared Function SQLDatum(dat As Date) As String 'Datum für SQLAbfrage umwandeln (31.01.1998 --> #1/31/1998#) SQLDatum = "" If Not IsDate(dat) Then Exit Function SQLDatum = "'" & DateAndTime.Day(dat) & "." & DateAndTime.Month(dat) & "." & DateAndTime.Year(dat) & " 00:00:00'" 'SQLDatum = dat.ToString End Function Public Shared Function SQLDatumZeit(dat As Date) As String 'Datum inklusive Zeit für SQLAbfrage umwandeln (31.01.1998 10:15 Uhr --> #1/31/1998 10:15:00#) SQLDatumZeit = "" If Not IsDate(dat) Then Exit Function SQLDatumZeit = "'" & DateAndTime.Day(dat) & "." & DateAndTime.Month(dat) & "." & DateAndTime.Year(dat) & " " & DateAndTime.Hour(dat) & ":" & DateAndTime.Minute(dat) & "'" End Function Public Shared Function SQLDatumZeitSekunden(dat As Date) As String 'Datum inklusive Zeit für SQLAbfrage umwandeln (31.01.1998 10:15 Uhr --> #1/31/1998 10:15:00#) SQLDatumZeitSekunden = "" If Not IsDate(dat) Then Exit Function SQLDatumZeitSekunden = "'" & DateAndTime.Day(dat) & "." & DateAndTime.Month(dat) & "." & DateAndTime.Year(dat) & " " & DateAndTime.Hour(dat) & ":" & DateAndTime.Minute(dat) & ":" & DateAndTime.Second(dat) & "'" End Function Public Shared Function SQLNullDate(d As Date) As Object 'Wenn Datum 00.00.0000, dann wird dbnull zurückgegeben If d = New Date Then : SQLNullDate = DBNull.Value Else : SQLNullDate = d : End If End Function Public Shared Function VarToInt(ByVal wert As Object) As Integer Try If wert Is Nothing OrElse wert Is DBNull.Value Then Return 0 Else Return CInt(wert) End If Catch generatedExceptionName As Exception Return 0 End Try End Function Public Shared Function VarToInt2(ByVal wert As Object) As Integer Try If wert Is Nothing OrElse wert Is DBNull.Value OrElse Not IsNumeric(wert) Then Return -1 Else Return CInt(wert) End If Catch generatedExceptionName As Exception Return -1 End Try End Function Public Shared Function VarToBool(ByVal wert As Object) As Boolean Try If wert Is Nothing OrElse wert Is DBNull.Value Then Return False Else Return CBool(wert) End If Catch generatedExceptionName As Exception Return False End Try End Function Public Shared Function VarToStr(ByVal wert As Object) As String Try If wert Is Nothing OrElse wert Is DBNull.Value Then Return "" Else Return Trim(DirectCast(wert, String)) End If Catch generatedExceptionName As Exception Return "" End Try End Function Private Sub Button19_Click(sender As Object, e As EventArgs) Handles Button19.Click Dim test = VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = cbxTESTSYSTEMATLAS.Checked Dim cnt = 1 'dim listAVISO = New List(Of cAviso) Dim sql As New VERAG_PROG_ALLGEMEIN.SQL Dim dt As DataTable = sql.loadDgvBySql(" exec atlas.dbo.kundenstamm @ndl = 'SUB'; ", "ATLAS") ' ' My.MySettings.Default.AVISO_ATILLAConnectionString For Each r As DataRow In dt.Rows If r("10 - Konto") IsNot DBNull.Value Then Dim KD_AKTO As New VERAG_PROG_ALLGEMEIN.cKundenAufschubkonten(r("Kundennummer"), 10) KD_AKTO.kdAkto_hauptzollamt = getHZA(r("10 - Konto")) KD_AKTO.kdAkto_eori = If(r("10 - EORI") Is DBNull.Value, DBNull.Value, r("10 - EORI").trim) KD_AKTO.kdAkto_eoriNL = r("10 - EORI-Ndl.") KD_AKTO.kdAkto_bin = r("10 - BIN") KD_AKTO.kdAkto_kontonummer = getKTO(r("10 - Konto"), KD_AKTO.kdAkto_hauptzollamt) KD_AKTO.SAVE() End If If r("15 - Konto") IsNot DBNull.Value Then Dim KD_AKTO As New VERAG_PROG_ALLGEMEIN.cKundenAufschubkonten(r("Kundennummer"), 15) KD_AKTO.kdAkto_hauptzollamt = getHZA(r("15 - Konto")) KD_AKTO.kdAkto_eori = If(r("15 - EORI") Is DBNull.Value, DBNull.Value, r("15 - EORI").trim) KD_AKTO.kdAkto_eoriNL = r("15 - EORI-Ndl.") KD_AKTO.kdAkto_bin = r("15 - BIN") KD_AKTO.kdAkto_kontonummer = getKTO(r("15 - Konto"), KD_AKTO.kdAkto_hauptzollamt) KD_AKTO.SAVE() End If If r("20 - Konto") IsNot DBNull.Value Then Dim KD_AKTO As New VERAG_PROG_ALLGEMEIN.cKundenAufschubkonten(r("Kundennummer"), 20) KD_AKTO.kdAkto_hauptzollamt = getHZA(r("20 - Konto")) KD_AKTO.kdAkto_eori = If(r("20 - EORI") Is DBNull.Value, DBNull.Value, r("20 - EORI").trim) KD_AKTO.kdAkto_eoriNL = r("20 - EORI-Ndl.") KD_AKTO.kdAkto_bin = r("20 - BIN") KD_AKTO.kdAkto_kontonummer = getKTO(r("20 - Konto"), KD_AKTO.kdAkto_hauptzollamt) KD_AKTO.SAVE() End If If cnt Mod 5 = 0 Or cnt = dt.Rows.Count Then Label5.Text = cnt & "/" & dt.Rows.Count ' StopZeit = DateTime.Now ' Label4.Text = GetTimeInterval(DateDiff(DateInterval.Second, StartZeit, StopZeit)) Me.Refresh() End If cnt += 1 Next VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = test End Sub Function getHZA(kto As Object) As Object If kto Is DBNull.Value Then Return kto getHZA = "" For Each s In kto If Not IsNumeric(s) Then getHZA &= s Else getHZA = getHZA.Trim Exit For End If Next If getHZA = "" Then getHZA = DBNull.Value End Function Function getKTO(kto As Object, hza As Object) As Object getKTO = DBNull.Value If kto Is DBNull.Value Then Return kto ' If hza Is DBNull.Value AndAlso IsNumeric(kto) Then Return kto If hza Is DBNull.Value AndAlso kto Is DBNull.Value Then Return DBNull.Value If hza Is DBNull.Value Then If IsNumeric(kto) Then getKTO = kto Else If hza.Length = 0 Then If IsNumeric(kto) Then getKTO = kto Else getKTO = kto.Replace(hza, "").Trim End If End If If getKTO IsNot DBNull.Value Then If getKTO = "" OrElse (IsNumeric(getKTO) AndAlso CInt(getKTO) = 0) Then getKTO = DBNull.Value End If End Function Private Sub Button20_Click(sender As Object, e As EventArgs) Handles Button20.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 = CheckBox2.Checked Dim cnt = 1 'dim listAVISO = New List(Of cAviso) Dim sql As New VERAG_PROG_ALLGEMEIN.SQL Dim Excel1 As New Microsoft.Office.Interop.Excel.Application ' Dim txt As String Try ' MsgBox("C:\Users\DEVELOPER1\Desktop\HUGOtest.xlsx") Excel1.Workbooks.Open("C:\Users\DEVELOPER1\Desktop\HUGO Nicht importiert - Korrigierte KZ2.xlsx") 'Excel1.Visible = True ....wers braucht ? ' For i = 2 To 5 ' MsgBox("A" & i & ":K" & i & "") Dim cells = Excel1.Range("A2:K6") For i = 1 To CInt(TextBox3.Text) If cells(i, 4) IsNot Nothing AndAlso cells(i, 4).value IsNot Nothing And cells(i, 4).value <> "" Then sql.doSQL("INSERT INTO sdl (KundenNr,KfzKennzeichen,SDLNr,History,Bestelldatum,Lieferdatum,KartenNr,OBUID,PIN,GültigBis,Vermerk, Erfassungsdatum,Sachbearbeiter) " & " VALUES(" & iNN(cells(i, 1)) & "," & iNN(cells(i, 4)).Replace(" ", "") & ",'213'," & iNN(cells(i, 3)) & "," & iNN(cells(i, 5)) & "," & iNN(cells(i, 6)) & "," & iNN(cells(i, 7)) & "," & iNN(cells(i, 8)) & "," & iNN(cells(i, 9)) & "," & iNN(cells(i, 10)) & "," & iNN(cells(i, 11)) & ",'" & Now.ToShortDateString & "','IMPORT')", "SDL") End If 'MsgBox(cells(i, 4).value) 'Kdnr Next 'For Each cells In Excel1.Range("A" & i & ":K" & i & "").Cells 'cells() 'Next ' Next Catch ex As Exception MessageBox.Show("Datei nicht vorhanden.") Finally Excel1.Application.Quit() End Try VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = test End Sub Function iNN(o As Object) As String Try If o.value.ToString = "" Then Return "null" Else Return "'" & o.value.ToString & "'" End If Catch ex As Exception Return "null" End Try End Function Private Sub btn_Click(sender As Object, e As EventArgs) Handles btn.Click 'Dim pf As New cProgramFunctions 'For i = CInt(TextBox6.Text) To CInt(TextBox7.Text) ' Dim kw = i ' Dim jahr = TextBox5.Text ' pf.KWAbschluss(TextBox4.Text, jahr, kw, getSchicht(kw, jahr)) 'Next End Sub Function getSchicht(aktWoche, aktJahr) As String ' Dim dStart As Date = CalendarWeek(aktWoche, aktJahr) ' Label1.Text = dStart & " - " & dStart.AddDays(6) ' lblKW.Text = "KW " & aktWoche If EvenNumber(GetWeekStartDate(aktWoche, aktJahr)) = False Then Return "ROT" Else Return "BLAU" End If End Function Private Function GetWeekStartDate(weekNumber As Integer, year As Integer) As Date Dim startDate As New DateTime(year, 1, 1) Dim weekDate As DateTime = DateAdd(DateInterval.WeekOfYear, weekNumber - 1, startDate) Return DateAdd(DateInterval.Day, (-weekDate.DayOfWeek) + 1, weekDate) End Function Public Function EvenNumber(aktDate) As Boolean Dim RefDate As Date = CDate("01.08.2015") Dim wD As Long = DateDiff(DateInterval.Weekday, aktDate, RefDate) EvenNumber = (wD And 1&) = 0& End Function Function isleernothing(s) As Object If s Is DBNull.Value Then Return Nothing If s.ToString.Trim = "" Then Return Nothing Return s.trim End Function Private Sub Button21_Click(sender As Object, e As EventArgs) Handles Button21.Click, Button22.Click Dim test = VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = cbxTESTSYSTEMATLAS.Checked Dim cnt = 1 Dim cnt2 = 1 'dim listAVISO = New List(Of cAviso) Dim sql As New VERAG_PROG_ALLGEMEIN.SQL Dim dt As DataTable = Nothing If sender Is Button21 Then dt = sql.loadDgvBySql(" exec atlas.dbo.kundenstamm @ndl = 'SUB'; ", "ATLAS") ' ElseIf sender Is Button22 Then dt = sql.loadDgvBySql(" exec atlas.dbo.kundenstamm @ndl = 'SBG'; ", "ATLAS_SBG") ' End If ' My.MySettings.Default.AVISO_ATILLAConnectionString For Each r As DataRow In dt.Rows If r("Kundennummer") IsNot DBNull.Value AndAlso r("Kundennummer") IsNot Nothing AndAlso IsNumeric(r("Kundennummer")) Then If r("Kundennummer") > 750000 And r("Kundennummer") < 800000 Then Dim AD As New VERAG_PROG_ALLGEMEIN.cAdressen(r("Kundennummer")) Dim KD As New VERAG_PROG_ALLGEMEIN.cKunde(r("Kundennummer")) If True Then 'Nur wenn EORI Noch nicht vorkommt: If sql.getValueTxtBySql("SELECT COUNT(*) FROM KUNDEN WHERE EORITIN='" & If(isleernothing(r("EORI")), "").ToString.Replace(" ", "") & "'", "FMZOLL") = 0 Then 'NEUANLAGE If AD.hasEntry Or KD.hasEntry Then ' MsgBox("NEW: " & VERAG_PROG_ALLGEMEIN.cAdressen.getNewAdressenNr752000) AD.AdressenNr = VERAG_PROG_ALLGEMEIN.cAdressen.getNewAdressenNr752000 ' KD.KundenNr = AD.AdressenNr ' MsgBox("T1: " & AD.AdressenNr) Else AD.AdressenNr = r("Kundennummer").trim ' KD.KundenNr = r("Kundennummer").trim ' MsgBox("T2: " & AD.AdressenNr & " - " & r("Kundennummer").trim) End If ' MsgBox(AD.AdressenNr) KD.KundenNr = AD.AdressenNr txt.Text &= AD.AdressenNr & vbNewLine ' MsgBox(r("Kurzname") & " - " & If(isleernothing(r("Kurzname")), "").ToString.Replace(" ", "") & " - " & sql.getValueTxtBySql("SELECT COUNT(*) FROM Adressen WHERE Ordnungsbegriff='" & If(isleernothing(r("Kurzname")), "").ToString.Replace(" ", "") & "'", "FMZOLL")) If sql.getValueTxtBySql("SELECT COUNT(*) FROM Adressen WHERE Ordnungsbegriff='" & If(isleernothing(r("Kurzname")), "").ToString.Trim & "'", "FMZOLL") > 0 Then ' MsgBox("DO!") ' AD.Ordnungsbegriff = r("Kurzname") & " " TextBox9.Text &= r("Kurzname") & vbNewLine Else AD.Ordnungsbegriff = r("Kurzname") AD.Straße = isleernothing(r("Strasse")) AD.Name_1 = isleernothing(r("Name 1")) ' MsgBox(isleernothing(r("Name 2"))) AD.Name_2 = isleernothing(r("Name 2")) AD.PLZ = isleernothing(r("PLZ")) AD.Ort = isleernothing(r("Ort")) AD.Auswahl = "A" AD.LandKz = isleernothing(cProgramFunctions.getISO1Land(r("Land"))) AD.Eingegeben_am = Now AD.Rechnungsdruck = True KD.EORITIN = If(isleernothing(r("EORI")), "").Replace(" ", "") If KD.EORITIN = "" Then KD.EORITIN = Nothing KD.KundenNrZentrale = KD.KundenNr KD.Eingegeben_am = Now KD.Vorlageprovision = 0.01 KD.Kreditaufwendungen = 0.02 KD.Bankspesen = 0 KD.Bankspesen_Mindestbetrag = 0 KD.Sammelrechnung = 0 KD.Steuerschlüssel = 10 KD.Kreditlimit = 2600 KD.Überwachungskunde = 0 KD.Abfertigungsverbot = 0 KD.Rechtsanwalt = 0 KD.Währungscode = "EUR" 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() And KD.SAVE() Then If r("10 - Konto") IsNot DBNull.Value Then Dim KD_AKTO As New VERAG_PROG_ALLGEMEIN.cKundenAufschubkonten(AD.AdressenNr, 10) KD_AKTO.kdAkto_hauptzollamt = getHZA(r("10 - Konto")) KD_AKTO.kdAkto_eori = If(r("10 - EORI") Is DBNull.Value, DBNull.Value, r("10 - EORI").trim) KD_AKTO.kdAkto_eoriNL = r("10 - EORI-Ndl.") KD_AKTO.kdAkto_bin = r("10 - BIN") KD_AKTO.kdAkto_kontonummer = getKTO(r("10 - Konto"), KD_AKTO.kdAkto_hauptzollamt) KD_AKTO.SAVE() End If If r("15 - Konto") IsNot DBNull.Value Then Dim KD_AKTO As New VERAG_PROG_ALLGEMEIN.cKundenAufschubkonten(AD.AdressenNr, 15) KD_AKTO.kdAkto_hauptzollamt = getHZA(r("15 - Konto")) KD_AKTO.kdAkto_eori = If(r("15 - EORI") Is DBNull.Value, DBNull.Value, r("15 - EORI").trim) KD_AKTO.kdAkto_eoriNL = r("15 - EORI-Ndl.") KD_AKTO.kdAkto_bin = r("15 - BIN") KD_AKTO.kdAkto_kontonummer = getKTO(r("15 - Konto"), KD_AKTO.kdAkto_hauptzollamt) KD_AKTO.SAVE() End If If r("20 - Konto") IsNot DBNull.Value Then Dim KD_AKTO As New VERAG_PROG_ALLGEMEIN.cKundenAufschubkonten(AD.AdressenNr, 20) KD_AKTO.kdAkto_hauptzollamt = getHZA(r("20 - Konto")) KD_AKTO.kdAkto_eori = If(r("20 - EORI") Is DBNull.Value, DBNull.Value, r("20 - EORI").trim) KD_AKTO.kdAkto_eoriNL = r("20 - EORI-Ndl.") KD_AKTO.kdAkto_bin = r("20 - BIN") KD_AKTO.kdAkto_kontonummer = getKTO(r("20 - Konto"), KD_AKTO.kdAkto_hauptzollamt) KD_AKTO.SAVE() End If End If If cnt2 >= TextBox8.Text Then Exit For cnt2 += 1 End If End If End If End If End If If cnt Mod 5 = 0 Or cnt = dt.Rows.Count Then Label5.Text = cnt & "/" & dt.Rows.Count ' StopZeit = DateTime.Now ' Label4.Text = GetTimeInterval(DateDiff(DateInterval.Second, StartZeit, StopZeit)) Me.Refresh() End If cnt += 1 Next VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = test End Sub Private Sub Button23_Click(sender As Object, e As EventArgs) Handles Button23.Click MsgBox(Now.ToString("ddd")) MsgBox(Now.ToString("ddd", New System.Globalization.CultureInfo("de-DE")).ToUpper) End Sub Private Sub Button24_Click(sender As Object, e As EventArgs) Handles Button24.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 = CheckBox3.Checked Dim cnt = 0 'dim listAVISO = New List(Of cAviso) Dim sql As New VERAG_PROG_ALLGEMEIN.SQL Dim kdnr_tmp = "" Try Dim fd As New OpenFileDialog If fd.ShowDialog = DialogResult.OK Then If fd.FileName.EndsWith(".CSV") Then ' fd.FileName.EndsWith(".csv") Using MyReader As New Microsoft.VisualBasic.FileIO.TextFieldParser(fd.FileName, Encoding.Default) MyReader.TextFieldType = FileIO.FieldType.Delimited MyReader.SetDelimiters(";") Dim currentRow As String() While Not MyReader.EndOfData Try ' If cnt > 100 Then Exit Sub currentRow = MyReader.ReadFields() ' Dim currentField As String Dim kdnr As Integer = 1000000 If currentRow.Length > 2 Then If IsNumeric(currentRow(2).Trim()) Then If currentRow.Length > 10 Then kdnr += CInt(currentRow(2).Trim()) kdnr_tmp = kdnr ' MsgBox(kdnr) Dim KD As New VERAG_PROG_ALLGEMEIN.cKunde(kdnr) If Not KD.hasEntry Then Dim AD As New VERAG_PROG_ALLGEMEIN.cAdressen(kdnr) If currentRow(3).Trim.ToString.Length > 40 Then If currentRow(3).Trim.ToString.Length > 80 Then AD.Name_1 = currentRow(3).Trim.Substring(0, 40) AD.Name_2 = isleernothing(currentRow(3).Trim.Substring(40, 40)) Else AD.Name_1 = currentRow(3).Trim.Substring(0, 40) AD.Name_2 = isleernothing(currentRow(3).Trim.Substring(40)) End If Else AD.Name_1 = getTrimedString(currentRow(3).Trim, 40) End If AD.Straße = isleernothing(getTrimedString(currentRow(6), 40)) If IsNumeric(isleernothing(getTrimedString(currentRow(8), 7))) Then AD.PLZ = isleernothing(getTrimedString(currentRow(8), 7)) End If AD.Ort = isleernothing(getTrimedString(currentRow(9), 40)) AD.LandKz = isleernothing(getTrimedString(currentRow(10), 3)) If currentRow.Length > 12 Then AD.Telefon = isleernothing(getTrimedString(currentRow(11), 20)) AD.Telefax = isleernothing(getTrimedString(currentRow(12), 20)) If currentRow.Length > 22 Then AD.Ansprechpartner = isleernothing(getTrimedString(currentRow(15), 20)) If If(AD.Ansprechpartner, "").ToString.Trim = "?" Then AD.Ansprechpartner = Nothing AD.E_Mail = isleernothing(getTrimedString(currentRow(13), 40)) If currentRow(18).ToString.Trim.Length > 4 Then If IsNumeric(currentRow(18).Trim.Substring(2)) Then 'DE AD.UstIdKz = getTrimedString(currentRow(18), 2) AD.UstIdNr = getTrimedString(currentRow(18).Trim.Substring(2), 12) ElseIf IsNumeric(currentRow(18).Trim.Substring(3)) Then 'ATU AD.UstIdKz = getTrimedString(currentRow(18), 2) AD.UstIdNr = getTrimedString(currentRow(18).Trim.Substring(2), 12) End If End If KD.EORITIN = isleernothing(getTrimedString(currentRow(19), 17)) If If(KD.EORITIN, "").ToString.Trim = "?" Then KD.EORITIN = Nothing KD.Abfertigungsverbot_Grund = isleernothing(getTrimedString(currentRow(21), 20)) KD.Abfertigungsverbot = getTrimedString((If(KD.Abfertigungsverbot_Grund, "").ToString.Replace(",", "").Length > 0), 500) KD.Besonderheiten = isleernothing(getTrimedString(currentRow(22), 2000)) End If End If KD.KundenNrZentrale = KD.KundenNr KD.FilialenNr = 5501 KD.Sachbearbeiter = "AUTO" KD.Währungscode = "EUR" KD.Eingegeben_am = Now.ToShortDateString KD.Vorlageprovision = 0 AD.Ordnungsbegriff = getTrimedString(AD.Name_1 & "; " & AD.Ort, 50) AD.Sachbearbeiter = "AUTO" AD.Eingegeben_am = Now.ToShortDateString AD.Auswahl = "A" AD.LandKz = isleernothing(cProgramFunctions.getISO1Land(AD.LandKz)) AD.Rechnungsdruck = True If KD.EORITIN = "" 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 currentRow.Length > 14 Then sql.doSQL("DELETE FROM tblKundenVollmachten WHERE kdvm_KundenNr='" & KD.KundenNr & "'", "FMZOLL") If currentRow(14).ToString.Length >= 10 Then If IsDate(currentRow(14).ToString.Substring(0, 10)) Then Dim vollmacht = CDate(currentRow(14).ToString.Substring(0, 10)) KD.Zollvollmacht_vom = True KD.Zollvollmacht = CDate(vollmacht).ToShortDateString sql.doSQL("INSERT INTO tblKundenVollmachten " & " ( DYIMPORT.kdvm_KundenNr], DYIMPORT.kdvm_kdvmaId] , DYIMPORT.kdvm_erhalten], DYIMPORT.kdvm_erhalten_Datum], DYIMPORT.kdvm_Info], DYIMPORT.kdvm_datenarchivId]) " & " VALUES ('" & KD.KundenNr & "',5 ,1,'" & CDate(vollmacht).ToShortDateString & "','',null) ", "FMZOLL") Else KD.Zollvollmacht_vom = False End If Else KD.Zollvollmacht_vom = False End If End If 'If AD.doesOrdnungsbegriffExist Then ' AD.Ordnungsbegriff = getTrimedString(AD.Ordnungsbegriff, 42) & " " & AD.AdressenNr 'End If If AD.doesOrdnungsbegriffExist Then AD.Ordnungsbegriff = getTrimedString(AD.Ordnungsbegriff, 43) & " (IMEX)" End If If AD.SAVE() AndAlso KD.SAVE() Then TextBox10.Text &= AD.AdressenNr & " " & AD.Ordnungsbegriff & vbNewLine Else MsgBox("FEHLER: " & currentRow(2).Trim()) End If Else TextBox11.Text &= kdnr & vbNewLine If KD.Besonderheiten <> getTrimedString(currentRow(22), 2000) Then TextBox12.Text &= kdnr & vbNewLine End If If cnt Mod 10 = 0 Then Application.DoEvents() Label10.Text = (cnt + 1) End If Else 'MsgBox(currentRow(2)) End If End If End If 'For Each currentField In currentRow cnt += 1 'Next Catch ex As Exception MsgBox(kdnr_tmp & " " & ex.Message & ex.StackTrace) End Try End While End Using End If End If Catch ex As Exception MessageBox.Show("Datei nicht vorhanden.") Finally End Try VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = test End Sub Private Sub Button27_Click(sender As Object, e As EventArgs) Handles Button27.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 = CheckBox4.Checked Dim cnt = 0 'dim listAVISO = New List(Of cAviso) Dim sql As New VERAG_PROG_ALLGEMEIN.SQL Dim kdnr_tmp = "" Try Dim fd As New OpenFileDialog If fd.ShowDialog = DialogResult.OK Then If fd.FileName.ToUpper.EndsWith(".MDB") Then 'Dim Datenbank As OleDbConnection 'Dim DaHeadertest As OleDbDataAdapter 'Dim DsHeadertest As DataSet 'Datenbank = New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & fd.FileName) 'DaHeadertest = New OleDbDataAdapter("show tables", Datenbank) 'DsHeadertest = New DataSet 'DaHeadertest.Fill(DsHeadertest) 'For Each dr As System.Data.DataRow In DsHeadertest.Tables("KundenKartei").Rows ' MessageBox.Show(dr(1)) 'Next 'Exit Sub Dim Datenbank As OleDbConnection Dim DaHeadertest As OleDbDataAdapter Dim DsHeadertest As DataSet ' MsgBox("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & fd.FileName) ' Datenbank = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & fd.FileName) Datenbank = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & fd.FileName) ' cGlobal.ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & pfadDatei 'DaHeadertest = New OleDbDataAdapter("show tables", Datenbank) 'DsHeadertest = New DataSet 'DaHeadertest.Fill(DsHeadertest) 'For Each dr As System.Data.DataRow In DsHeadertest.Tables("Kunden Kartei").Rows ' MessageBox.Show(dr(1)) 'Next Dim query = "SELECT * FROM KundenKartei" Dim Table_ = "KundenKartei" Dim ds As New DataSet Dim cnn As OleDbConnection = New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & fd.FileName) cnn.Open() Dim cmd As New OleDbCommand(query, cnn) Dim da As New OleDbDataAdapter(cmd) da.Fill(ds, Table_) cnn.Close() Dim t1 As DataTable = ds.Tables(Table_) Dim row As DataRow Dim Item(2) As String For Each row In t1.Rows Dim kdnr As Integer = 2000000 If IsNumeric(row("Debitorennr")) Then kdnr += CInt(row("Debitorennr")) Else kdnr += CInt(row("Kundennummer")) End If Dim KD As New VERAG_PROG_ALLGEMEIN.cKunde(kdnr) If Not KD.hasEntry Then ' MsgBox(kdnr) Dim AD As New VERAG_PROG_ALLGEMEIN.cAdressen(kdnr) Dim KDE As New VERAG_PROG_ALLGEMEIN.cKundenErweitert(kdnr) AD.Auswahl = If(CBool(row("gelöscht")), "I", "A") AD.Ordnungsbegriff = row("Kundencode").ToString.ToUpper AD.Name_1 = getTrimedStringACCES(row("Name"), 40) AD.Name_2 = isleernothing(getTrimedStringACCES(row("Gesellschaft"), 40)) If AD.Name_1 = "" Then AD.Name_1 = AD.Ordnungsbegriff AD.Straße = isleernothing(getTrimedStringACCES(row("Straße"), 40)) AD.Ort = isleernothing(getTrimedStringACCES(row("Ort"), 40)) AD.PLZ = isleernothing(getTrimedStringACCES(row("PLZ"), 7)) AD.LandKz = isleernothing(getTrimedStringACCES(row("Land"), 3)) AD.Telefon = isleernothing(getTrimedStringACCES(row("Telefonnr"), 20)) AD.Mobiltelefon = isleernothing(getTrimedStringACCES(row("Mobil"), 20)) AD.Telefax = isleernothing(getTrimedStringACCES(row("Faxnr"), 20)) AD.E_Mail = isleernothing(getTrimedStringACCES(row("Email1"), 40).ToString.Replace("mailto:", "").Replace("#", "")) AD.E_Mail2 = isleernothing(getTrimedStringACCES(row("Email2"), 40).ToString.Replace("mailto:", "").Replace("#", "")) ' AD. = row("Internet1") AD.Ansprechpartner = isleernothing(getTrimedStringACCES(row("Ansprechpartner"), 40)) KD.Währungscode = "EUR" 'getTrimedStringACCES(row("Standard FakturenWährung"), 3) KD.Zahlungsziel = getTrimedStringACCES(row("Zahlungsziel"), 3) ' Offerte ?? Dim Allg = "" If getTrimedStringACCES(row("ÖVZ"), 9999) <> "" Then Allg &= "Offert ÖVZ: " & getTrimedStringACCESEUR(row("ÖVZ"), 99999) & vbNewLine If getTrimedStringACCES(row("ÖVZ_Fiskal"), 9999) <> "" Then Allg &= "Offert ÖVZ_Fiskal: " & getTrimedStringACCESEUR(row("ÖVZ_Fiskal"), 99999) & vbNewLine If getTrimedStringACCES(row("DVZ"), 9999) <> "" Then Allg &= "Offert DVZ: " & getTrimedStringACCESEUR(row("DVZ"), 99999) & vbNewLine If getTrimedStringACCES(row("DVZ_Fiskal"), 9999) <> "" Then Allg &= "Offert DVZ_Fiskal: " & getTrimedStringACCESEUR(row("DVZ_Fiskal"), 99999) & vbNewLine If getTrimedStringACCES(row("T1"), 9999) <> "" Then Allg &= "Offert T1: " & getTrimedStringACCESEUR(row("T1"), 99999) & vbNewLine If getTrimedStringACCES(row("AE"), 9999) <> "" Then Allg &= "Offert AE: " & getTrimedStringACCESEUR(row("AE"), 99999) & vbNewLine If getTrimedStringACCES(row("AE_ATR"), 9999) <> "" Then Allg &= "Offert AE_ATR: " & getTrimedStringACCESEUR(row("AE_ATR"), 99999) & vbNewLine If getTrimedStringACCES(row("eZoll_Zuschlag"), 9999) <> "" Then Allg &= "Offert eZoll_Zuschlag: " & getTrimedStringACCESEUR(row("eZoll_Zuschlag"), 99999) & vbNewLine If getTrimedStringACCES(row("Atlas_Zuschlag"), 9999) <> "" Then Allg &= "Offert Atlas_Zuschlag: " & getTrimedStringACCESEUR(row("Atlas_Zuschlag"), 99999) & vbNewLine If getTrimedStringACCES(row("TNR_Zuschlag"), 9999) <> "" Then Allg &= "Offert TNR_Zuschlag: " & getTrimedStringACCESEUR(row("TNR_Zuschlag"), 99999) & vbNewLine If getTrimedStringACCES(row("TNR_Zuschlag_Hinweis"), 9999) <> "" Then Allg &= "Offert TNR_Zuschlag_Hinweis: " & getTrimedStringACCESEUR(row("TNR_Zuschlag_Hinweis"), 99999) & vbNewLine If getTrimedStringACCES(row("TNR_Zuschlag_Hinweis"), 9999) <> "" Then Allg &= "Offert TNR_Zuschlag_Hinweis: " & getTrimedStringACCESEUR(row("TNR_Zuschlag_Hinweis"), 99999) & vbNewLine If getTrimedStringACCES(row("Porti"), 9999) <> "" Then Allg &= "Offert Porti: " & getTrimedStringACCESEUR(row("Porti"), 99999) & vbNewLine If getTrimedStringACCES(row("SKR"), 9999) <> "" Then Allg &= "Offert SKR: " & getTrimedStringACCESEUR(row("SKR"), 99999) & vbNewLine If getTrimedStringACCES(row("Vorlage"), 9999) <> "" Then Allg &= "Offert Vorlage: " & getTrimedStringACCESEUR(row("Vorlage"), 99999) & vbNewLine If getTrimedStringACCES(row("Bargeldbeistellung"), 9999) <> "" Then Allg &= "Offert Bargeldbeistellung: " & getTrimedStringACCESEUR(row("Bargeldbeistellung"), 99999) & vbNewLine If getTrimedStringACCES(row("Vorlage"), 9999) <> "" Then Allg &= "Offert Vorlage: " & getTrimedStringACCESEUR(row("Vorlage"), 99999) & vbNewLine If getTrimedStringACCES(row("Abrechnungssätze_Anmerkungen"), 9999) <> "" Then Allg &= "Abrechnung: " & getTrimedStringACCES(row("Abrechnungssätze_Anmerkungen"), 99999) & vbNewLine If getTrimedStringACCES(row("Abfertigungsort"), 9999) <> "" Then Allg &= "Abfertigungsort: " & getTrimedStringACCES(row("Abfertigungsort"), 99999) & vbNewLine If getTrimedStringACCES(row("Handelsregisterauszug"), 9999) <> "" Then Allg &= "Handelsregisterauszug: " & getTrimedStringACCES(row("Handelsregisterauszug"), 99999) & vbNewLine If getTrimedStringACCES(row("Passkopie"), 9999) <> "" Then Allg &= "Passkopie: " & getTrimedStringACCES(row("Passkopie"), 99999) & vbNewLine If (IsNumeric(getTrimedStringACCES(row("Creditreform_Rating"), 3))) Then KD.Bonität = getTrimedStringACCES(row("Creditreform_Rating"), 3) If (IsDate(getTrimedStringACCES(row("Creditreform_Abfrage_Datum"), 99999))) Then KD.Bonitätsdatum = getTrimedStringACCES(row("Creditreform_Abfrage_Datum"), 99999) If getTrimedStringACCES(row("Creditreform_Zahlungsziel"), 9999) <> "" Then Allg &= "Creditreform_Zahlungsziel: " & getTrimedStringACCES(row("Creditreform_Zahlungsziel"), 99999) & vbNewLine If getTrimedStringACCES(row("Creditreform_Anmerkung"), 9999) <> "" Then Allg &= "Creditreform_Anmerkung: " & getTrimedStringACCES(row("Creditreform_Anmerkung"), 99999) & vbNewLine If IsNumeric(getTrimedStringACCES(row("Creditreform_Höchstkredit"), 9999)) Then KD.Höchstkredit = CDbl(getTrimedStringACCES(row("Creditreform_Höchstkredit"), 9999)) If getTrimedStringACCES(row("UmsatzsteuerID"), 9999).Replace(" ", "").Length > 4 Then Dim ustTmp = getTrimedStringACCES(row("UmsatzsteuerID"), 9999).Replace(" ", "") Dim UST_Land = ustTmp.Substring(0, 2) Dim UST_NR = ustTmp.Substring(2) AD.UstIdKz = UST_Land AD.UstIdNr = UST_NR End If If AD.doesOrdnungsbegriffExist Then AD.Ordnungsbegriff = getTrimedStringACCES(AD.Ordnungsbegriff, 43) & " (UNISPED)" End If KD.Zollnummer = isleernothing(getTrimedStringACCES(getTrimedStringACCES(row("ZollNr"), 99).Replace(" ", ""), 7)) KD.EORITIN = isleernothing(getTrimedStringACCES(getTrimedStringACCES(row("EORINr"), 99).Replace(" ", ""), 17)) If getTrimedStringACCES(row("Abgabenkonto"), 9999) <> "" Then Allg &= "Abgabenkonto: " & getTrimedStringACCES(row("Abgabenkonto"), 99999) & vbNewLine If getTrimedStringACCES(row("Aufschubkonto_EUST"), 9999) <> "" Then Allg &= "Aufschub-EUST: " & getTrimedStringACCES(row("Aufschubkonto_EUST"), 99999) & vbNewLine If getTrimedStringACCES(row("Aufschubkonto_ZOLL"), 9999) <> "" Then Allg &= "Aufschub-ZOLL: " & getTrimedStringACCES(row("Aufschubkonto_ZOLL"), 99999) & vbNewLine If CBool(row("Aufschub_BIN")) Then Allg &= "Aufschub-BIN: JA" & vbNewLine AD.Steuernummer = isleernothing(getTrimedStringACCES(row("Steuernr_AT"), 20)) If getTrimedStringACCES(row("Steuernr_DE"), 9999) <> "" Then Allg &= "Steuernummer-DE: " & getTrimedStringACCES(row("Steuernr_DE"), 99999) & vbNewLine If getTrimedStringACCES(row("Vollmacht_ÖVZ"), 9999) <> "" Then Allg &= "Vollmacht_ÖVZ: " & getTrimedStringACCES(row("Vollmacht_ÖVZ"), 99999) & vbNewLine If getTrimedStringACCES(row("Vollmacht_ÖVZ_Fiskal"), 9999) <> "" Then Allg &= "Vollmacht_ÖVZ_Fiskal: " & getTrimedStringACCES(row("Vollmacht_ÖVZ_Fiskal"), 99999) & vbNewLine If getTrimedStringACCES(row("Erwerbssteuer"), 9999) <> "" Then Allg &= "Erwerbssteuer: " & getTrimedStringACCES(row("Erwerbssteuer"), 99999) & vbNewLine If getTrimedStringACCES(row("Vollmacht_DVZ"), 9999) <> "" Then Allg &= "Vollmacht_DVZ: " & getTrimedStringACCES(row("Vollmacht_DVZ"), 99999) & vbNewLine If getTrimedStringACCES(row("Vollmacht_DVZ_Fiskal"), 9999) <> "" Then Allg &= "Vollmacht_DVZ_Fiskal: " & getTrimedStringACCES(row("Vollmacht_DVZ_Fiskal"), 99999) & vbNewLine If getTrimedStringACCES(row("Vollmacht_AE"), 9999) <> "" Then Allg &= "Vollmacht_AE: " & getTrimedStringACCES(row("Vollmacht_AE"), 99999) & vbNewLine If getTrimedStringACCES(row("Vollmacht_AE_ATR"), 9999) <> "" Then Allg &= "Vollmacht_AE_ATR: " & getTrimedStringACCES(row("Vollmacht_AE_ATR"), 99999) & vbNewLine If getTrimedStringACCES(row("Vollmachten_Anmerkungen"), 9999) <> "" Then Allg &= "Vollmachten_Anmerkungen: " & getTrimedStringACCES(row("Vollmachten_Anmerkungen"), 99999) & vbNewLine If getTrimedStringACCES(row("Zoll_Anmerkungen"), 9999) <> "" Then Allg &= "Zoll_Anmerkungen: " & getTrimedStringACCES(row("Zoll_Anmerkungen"), 99999) & vbNewLine If getTrimedStringACCES(row("Zoll_Anmerkungen_Fiskal"), 9999) <> "" Then Allg &= "Zoll_Anmerkungen_Fiskal: " & getTrimedStringACCES(row("Zoll_Anmerkungen_Fiskal"), 99999) & vbNewLine If getTrimedStringACCES(row("Fiskal_Anmerkungen"), 9999) <> "" Then Allg &= "Fiskal_Anmerkungen: " & getTrimedStringACCES(row("Fiskal_Anmerkungen"), 99999) & vbNewLine KD.Abfertigungsverbot = CBool(row("Arbeitsverbot")) KD.Abfertigungsverbot_Grund = isleernothing((getTrimedStringACCES(row("Arbeitsverbot_Anmerkung"), 9999) & vbNewLine & getTrimedStringACCES(row("Anmerkungen_einblenden"), 9999)).Trim) If CBool(row("Mahnsperre")) Then Allg &= "Mahnsperre: JA" & vbNewLine If CBool(row("Rechnung_per_Email")) Then Allg &= "Rechnung_per_Email: JA" & vbNewLine ' Rechnung_per_Email If getTrimedStringACCES(row("Fiskal_Email_Monatsauswertung_Versand"), 9999) <> "" Then Allg &= "Fiskal_Email_Monatsauswertung_Versand: " & getTrimedStringACCES(row("Fiskal_Email_Monatsauswertung_Versand"), 99999) & vbNewLine If getTrimedStringACCES(row("Fiskal_Ansprechpartner"), 9999) <> "" Then Allg &= "Fiskal_Ansprechpartner: " & getTrimedStringACCES(row("Fiskal_Ansprechpartner"), 99999) & vbNewLine If getTrimedStringACCES(row("eZoll_AdressID"), 9999) <> "" Then Allg &= "eZoll_AdressID: " & getTrimedStringACCES(row("eZoll_AdressID"), 99999) & vbNewLine If getTrimedStringACCES(row("Geschäftszweig"), 9999) <> "" Then Allg &= "Geschäftszweig: " & getTrimedStringACCES(row("Geschäftszweig"), 99999) & vbNewLine If CBool(row("Rechnung_per_Email")) Then Allg &= "Rechnung_per_Email: JA" & vbNewLine ' If getTrimedStringACCES(row("Rechnung_per_Email"), 9999) <> "" Then Allg &= "Rechnung_per_Email: " & getTrimedStringACCES(row("Rechnung_per_Email"), 99999) & vbNewLine If getTrimedStringACCES(row("Email_Rechnungsversand"), 9999) <> "" Then Allg &= "Email_Rechnungsversand: " & getTrimedStringACCES(row("Email_Rechnungsversand"), 99999) & vbNewLine If getTrimedStringACCES(row("Steuerberater"), 9999) <> "" Then Allg &= "Steuerberater: " & getTrimedStringACCES(row("Steuerberater"), 99999) & vbNewLine If getTrimedStringACCES(row("Verbundenheit"), 9999) <> "" Then Allg &= "Verbundenheit: " & getTrimedStringACCES(row("Verbundenheit"), 99999) & vbNewLine If CBool(row("Unternehmerbescheinigung")) Then Allg &= "Unternehmerbescheinigung: JA" & vbNewLine If getTrimedStringACCES(row("Unternehmerbescheinigung_Anmerkung"), 9999) <> "" Then Allg &= "Unternehmerbescheinigung_Anmerkung: " & getTrimedStringACCES(row("Unternehmerbescheinigung_Anmerkung"), 99999) & vbNewLine If getTrimedStringACCES(row("Zahlungsbedingungen"), 9999) <> "" Then Allg &= "Zahlungsbedingungen: " & getTrimedStringACCES(row("Zahlungsbedingungen"), 99999) & vbNewLine If getTrimedStringACCES(row("Lieferbedingungen"), 9999) <> "" Then Allg &= "Lieferbedingungen: " & getTrimedStringACCES(row("Lieferbedingungen"), 99999) & vbNewLine ' If getTrimedStringACCES(row("KDE"), 9999) <> "" Then Allg &= "Anmerkungen_Warnhinweis: " & getTrimedStringACCES(row("Anmerkungen_Warnhinweis"), 99999) & vbNewLine KDE.Anmerkungen_Warnhinweis = getTrimedStringACCES(row("Anmerkungen_Warnhinweis"), 9999) If CBool(row("Post1")) Then Allg &= "Post1: JA" & vbNewLine ' AD.Eingegeben_am = CDate(row("erstellt")) If IsDate(row("zuletzt_geändert")) Then AD.Geändert_am = CDate(row("zuletzt_geändert")) ' KD.Eingegeben_am = CDate(row("erstellt")) If IsDate(row("zuletzt_geändert")) Then KD.Geändert_am = CDate(row("zuletzt_geändert")) AD.Sachbearbeiter = If(getTrimedStringACCES(row("User_zuletzt_geändert"), 99999) <> "", getTrimedStringACCES(row("User_zuletzt_geändert"), 99999), getTrimedStringACCES(row("User"), 99999)) KD.Sachbearbeiter = If(getTrimedStringACCES(row("User_zuletzt_geändert"), 99999) <> "", getTrimedStringACCES(row("User_zuletzt_geändert"), 99999), getTrimedStringACCES(row("User"), 99999)) KD.KundenNrZentrale = KD.KundenNr KD.FilialenNr = 5601 If KD.Sachbearbeiter = "" Then KD.Sachbearbeiter = "AUTO" KD.Währungscode = "EUR" KD.Eingegeben_am = Now.ToShortDateString ' AD.Ordnungsbegriff = getTrimedString(AD.Name_1 & "; " & AD.Ort, 50) If AD.Sachbearbeiter = "" Then AD.Sachbearbeiter = "AUTO" AD.Eingegeben_am = Now.ToShortDateString AD.LandKz = isleernothing(cProgramFunctions.getISO1Land(AD.LandKz)) AD.Rechnungsdruck = True If KD.EORITIN = "" 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 Allg <> "" Then Allg &= vbNewLine & "____________________________________________________________" & vbNewLine KD.Besonderheiten = isleernothing((Allg & getTrimedStringACCES(row("Sonstiges"), 99999)).Trim) Dim KDKont As New VERAG_PROG_ALLGEMEIN.cKundenKontakte() KDKont.kkd_KundenNr = kdnr KDKont.kkd_kkaId = 10 KDKont.kkd_kkaBez = "Fiskal" KDKont.kkd_Tel = isleernothing(getTrimedStringACCES(row("Fiskal_Telefon"), 40)) KDKont.kkd_Email = isleernothing(getTrimedStringACCES(row("Fiskal_Email1"), 40) & ";" & getTrimedStringACCES(row("Fiskal_Email2"), 40) & ";" & getTrimedStringACCES(row("Fiskal_Email3"), 40)) ' If (KDKont.kkd_Email.replace(";;", "") = "") Then KDKont.kkd_Email = "" KDKont.kkd_Email = KDKont.kkd_Email.replace(";;", ";") KDKont.kkd_Email = isleernothing(KDKont.kkd_Email) KDKont.kkd_Fax = isleernothing(getTrimedStringACCES(row("Fiskal_Faxnr"), 40)) KDKont.kkd_Mobil = isleernothing(getTrimedStringACCES(row("Fiskal_Mobil"), 40)) KDKont.kkd_AnsprechpartnerVorname = isleernothing(getTrimedStringACCES(row("Fiskal_Ansprechpartner"), 40)) If AD.SAVE() AndAlso KD.SAVE() AndAlso KDE.SAVE() Then VERAG_PROG_ALLGEMEIN.cKundenKontakte.DELETE_ALL_KONTAKTE(kdnr) 'alle Löschen! KDKont.SAVE() If getTrimedStringACCES(row("Email3"), 9999) <> "" Then insertKontakt(kdnr, getTrimedStringACCES(row("Email3"), 50).ToString.Replace("mailto:", "").Replace("#", ""), "Email3") If getTrimedStringACCES(row("EmailABD1"), 9999) <> "" Then insertKontakt(kdnr, getTrimedStringACCES(row("EmailABD1"), 30), "ABD01") If getTrimedStringACCES(row("EmailABD2"), 9999) <> "" Then insertKontakt(kdnr, getTrimedStringACCES(row("EmailABD2"), 30), "ABD02") If getTrimedStringACCES(row("EmailABD3"), 9999) <> "" Then insertKontakt(kdnr, getTrimedStringACCES(row("EmailABD3"), 30), "ABD03") TextBox10.Text &= AD.AdressenNr & " " & AD.Ordnungsbegriff & vbNewLine Else MsgBox("FEHLER: " & kdnr) End If ' AD.XXXXXXXXX = getTrimedStringACCES(row("XXXXXXXXXXXXXXXXXX"), 99999) End If 'Item(0) = row(0) 'Item(1) = row(1) 'Dim NextListItem As New ListViewItem(Item) 'ListView1.Items.Add(NextListItem) cnt += 1 Label14.Text = cnt Me.Refresh() 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 insertKontakt(kdnr, kkd_Email, kkd_AnsprechpartnerVorname) Dim KDKont As New VERAG_PROG_ALLGEMEIN.cKundenKontakte() KDKont.kkd_KundenNr = kdnr KDKont.kkd_kkaId = 1 KDKont.kkd_kkaBez = "Allgemein" KDKont.kkd_Email = kkd_Email KDKont.kkd_AnsprechpartnerVorname = KDKont.kkd_AnsprechpartnerVorname KDKont.SAVE() End Sub Function getTrimedString(s As String, l As Integer) As String Try If s Is Nothing Then Return "" If s.ToString.Length > l Then Return s.Substring(0, l) End If Return s.ToString Catch ex As Exception MsgBox("getTrimedString: " & ex.Message & ex.StackTrace) End Try Return "" End Function Function getTrimedStringACCES(s As Object, l As Integer) As String Try If s Is Nothing Then Return "" If s Is DBNull.Value Then Return "" If s.ToString.Length > l Then Return s.Substring(0, l) End If Return s Catch ex As Exception MsgBox("getTrimedString: " & ex.Message & ex.StackTrace) End Try Return "" End Function Function getTrimedStringACCESEUR(s As Object, l As Integer) As String Try If s Is Nothing Then Return "" If s Is DBNull.Value Then Return "" If s.ToString.Length > l Then Return s.Substring(0, l) End If If IsNumeric(s) Then Return CDbl(s).ToString("C2") End If Return s Catch ex As Exception MsgBox("getTrimedString: " & ex.Message & ex.StackTrace) End Try Return "" End Function Private Sub Button25_Click(sender As Object, e As EventArgs) Handles Button25.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 = CheckBox3.Checked Dim cnt = 0 'dim listAVISO = New List(Of cAviso) Dim sql As New VERAG_PROG_ALLGEMEIN.SQL Dim kdnr_tmp = "" Try Dim fd As New OpenFileDialog If fd.ShowDialog = DialogResult.OK Then If fd.FileName.EndsWith(".CSV") Then ' fd.FileName.EndsWith(".csv") Using MyReader As New Microsoft.VisualBasic.FileIO.TextFieldParser(fd.FileName, Encoding.UTF8) MyReader.TextFieldType = FileIO.FieldType.Delimited MyReader.SetDelimiters(";") Dim currentRow As String() While Not MyReader.EndOfData Try ' If cnt > 100 Then Exit Sub currentRow = MyReader.ReadFields() ' Dim currentField As String Dim kdnr As Integer = 1000000 If currentRow.Length > 2 Then If IsNumeric(currentRow(1).Trim()) Then If currentRow.Length > 22 Then kdnr += CInt(currentRow(1).Trim()) kdnr_tmp = kdnr Dim KD As New VERAG_PROG_ALLGEMEIN.cKunde(kdnr) Dim AD As New VERAG_PROG_ALLGEMEIN.cAdressen(kdnr) If True Then 'Not AD.hasEntry Then If currentRow(6).Trim.ToString.Length > 40 Then If currentRow(6).Trim.ToString.Length > 80 Then AD.Name_1 = currentRow(6).Trim.Substring(0, 40) AD.Name_2 = isleernothing(currentRow(6).Trim.Substring(40, 40)) Else AD.Name_1 = currentRow(6).Trim.Substring(0, 40) AD.Name_2 = isleernothing(currentRow(6).Trim.Substring(40)) End If Else AD.Name_1 = getTrimedString(currentRow(6).Trim, 40) End If Dim strasse = currentRow(8) & " " & currentRow(9) & " " & currentRow(10) & " " & currentRow(11).Trim AD.Straße = isleernothing(getTrimedString(strasse, 40)) If IsNumeric(isleernothing(getTrimedString(currentRow(13), 7))) Then AD.PLZ = isleernothing(getTrimedString(currentRow(13), 7)) End If AD.Ort = isleernothing(getTrimedString(currentRow(12), 40)) AD.LandKz = isleernothing(getTrimedString(currentRow(15), 3)) AD.Telefon = isleernothing(getTrimedString(currentRow(17), 20)) AD.Telefax = isleernothing(getTrimedString(currentRow(18), 20)) 'AD.Ansprechpartner = isleernothing(getTrimedString(currentRow(15), 20)) 'If If(AD.Ansprechpartner, "").ToString.Trim = "?" Then AD.Ansprechpartner = Nothing AD.E_Mail = isleernothing(getTrimedString(currentRow(19), 40)) If currentRow(25).ToString.Trim.Length > 4 Then If IsNumeric(currentRow(25).Trim.Substring(2)) Then 'DE AD.UstIdKz = getTrimedString(currentRow(25), 2) AD.UstIdNr = getTrimedString(currentRow(25).Trim.Substring(2), 12) ElseIf IsNumeric(currentRow(25).Trim.Substring(3)) Then 'ATU AD.UstIdKz = getTrimedString(currentRow(25), 2) AD.UstIdNr = getTrimedString(currentRow(25).Trim.Substring(2), 12) End If End If KD.EORITIN = isleernothing(getTrimedString(currentRow(27), 17)) If IsNumeric(currentRow(28)) Then KD.EORITIN_NL = CInt(currentRow(28)).ToString("0000") If If(KD.EORITIN, "").ToString.Trim = "?" Then KD.EORITIN = Nothing ' KD.Abfertigungsverbot_Grund = isleernothing(getTrimedString(currentRow(21), 20)) ' KD.Abfertigungsverbot = getTrimedString((If(KD.Abfertigungsverbot_Grund, "").ToString.Replace(",", "").Length > 0), 500) ' KD.Besonderheiten = isleernothing(getTrimedString(currentRow(22), 2000)) KD.KundenNrZentrale = KD.KundenNr KD.FilialenNr = 5501 KD.Sachbearbeiter = "AUTO" KD.Währungscode = "EUR" KD.Eingegeben_am = Now.ToShortDateString KD.Vorlageprovision = 0 If Not AD.hasEntry Then AD.Ordnungsbegriff = getTrimedString(currentRow(2) & "; " & AD.Ort, 50) If AD.Name_1.trim = "" Then AD.Name_1 = getTrimedString(AD.Ordnungsbegriff, 40) AD.Sachbearbeiter = "AUTO" AD.Eingegeben_am = Now.ToShortDateString AD.Auswahl = "A" AD.LandKz = isleernothing(cProgramFunctions.getISO1Land(AD.LandKz)) AD.Rechnungsdruck = True If KD.EORITIN = "" Then KD.EORITIN = Nothing KD.Vorlageprovision = 0.01 KD.Kreditaufwendungen = 0.02 KD.Bankspesen = 0 KD.Bankspesen_Mindestbetrag = 0 KD.SVS = True 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 'sql.doSQL("DELETE FROM tblKundenVollmachten WHERE kdvm_KundenNr='" & KD.KundenNr & "'", "FMZOLL") 'If currentRow(14).ToString.Length >= 10 Then ' If IsDate(currentRow(14).ToString.Substring(0, 10)) Then ' Dim vollmacht = CDate(currentRow(14).ToString.Substring(0, 10)) ' KD.Zollvollmacht_vom = True ' KD.Zollvollmacht = CDate(vollmacht).ToShortDateString ' sql.doSQL("INSERT INTO tblKundenVollmachten " & ' " ( DYIMPORT.kdvm_KundenNr], DYIMPORT.kdvm_kdvmaId] , DYIMPORT.kdvm_erhalten], DYIMPORT.kdvm_erhalten_Datum], DYIMPORT.kdvm_Info], DYIMPORT.kdvm_datenarchivId]) " & ' " VALUES ('" & KD.KundenNr & "',5 ,1,'" & CDate(vollmacht).ToShortDateString & "','',null) ", "FMZOLL") ' Else ' KD.Zollvollmacht_vom = False ' End If 'Else ' KD.Zollvollmacht_vom = False 'End If 'If AD.doesOrdnungsbegriffExist Then ' AD.Ordnungsbegriff = getTrimedString(AD.Ordnungsbegriff, 42) & " " & AD.AdressenNr 'End If If Not AD.hasEntry Then If AD.doesOrdnungsbegriffExist Then AD.Ordnungsbegriff = getTrimedString(AD.Ordnungsbegriff, 43) & " (IMEX)" If AD.doesOrdnungsbegriffExist Then AD.Ordnungsbegriff = AD.Ordnungsbegriff.ToString.Replace("(IMEX)", "(IMX2)") If AD.doesOrdnungsbegriffExist Then AD.Ordnungsbegriff = AD.Ordnungsbegriff.ToString.Replace("(IMX2)", "(IMX3)") If AD.doesOrdnungsbegriffExist Then AD.Ordnungsbegriff = AD.Ordnungsbegriff.ToString.Replace("(IMX3)", "(IMX4)") End If End If End If End If End If If AD.SAVE() AndAlso KD.SAVE() Then Else MsgBox("FEHLER: " & currentRow(1).Trim()) End If End If If cnt Mod 10 = 0 Then Application.DoEvents() Label10.Text = (cnt + 1) End If Else 'MsgBox(currentRow(1)) End If End If End If 'For Each currentField In currentRow cnt += 1 'Next Catch ex As Exception MsgBox(kdnr_tmp & " " & ex.Message & ex.StackTrace) End Try End While End Using End If End If Catch ex As Exception MessageBox.Show("Datei nicht vorhanden.") Finally End Try VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = test End Sub Private Sub Button26_Click(sender As Object, e As EventArgs) Handles Button26.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 = CheckBox4.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 = "\\10.4.3.17\VERAG gemeinsam\Excel Kundendaten\" 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 ' MsgBox(Blatt.Range("C" & index).Value) 'Dim valueX As String = "" Try 'valueX = Blatt.Range("C" & index).Value.ToString 'MsgBox(valueX) Dim kdnr As Integer = VERAG_PROG_ALLGEMEIN.cAdressen.getHoechsteKdNr( 0, 2499999) '+ 1 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("E" & index).Value Is Nothing Then AD.Ordnungsbegriff = getTrimedString(Blatt.Range("C" & index).Value.ToString, 40) Else AD.Ordnungsbegriff = getTrimedString((Blatt.Range("C" & index).Value.ToString) & "; " & (Blatt.Range("E" & index).Value.ToString), 40) End If AD.Name_1 = getTrimedString(Blatt.Range("C" & index).Value.ToString, 40) AD.Name_2 = Nothing AD.Straße = Nothing AD.Ort = getTrimedString(Blatt.Range("E" & index).Value.ToString, 40) If AD.Ort = "" Then AD.Ort = "-" Dim LandKz = "" Dim PLZ = "" Dim LandPlz = Blatt.Range("D" & index).Value.ToString If LandPlz.Contains("-") Then Dim sp = LandPlz.Split("-") LandKz = sp(0) PLZ = sp(1) 'MsgBox(LandKz) If sp.Length > 2 Then PLZ &= sp(2) End If AD.PLZ = sql.isleernothing(getTrimedString(PLZ.Trim, 7)) AD.LandKz = sql.isleernothing(getTrimedString(LandKz.Trim, 3)) AD.Telefon = Nothing AD.Mobiltelefon = Nothing AD.Telefax = Nothing AD.E_Mail = Nothing AD.E_Mail2 = Nothing ' AD. = row("Internet1") AD.Ansprechpartner = Nothing KD.Währungscode = "EUR" 'getTrimedStringACCES(row("Standard FakturenWährung"), 3) KD.Zahlungsziel = Nothing ' Offerte ?? Dim Allg = "" If Blatt.Range("A" & index).value IsNot Nothing Then Allg &= "FREMDKUNDE: " & Blatt.Range("A" & index).Value.ToString & vbNewLine If Blatt.Range("B" & index).value IsNot Nothing Then Allg &= "ABFERTIGUNGSART: " & Blatt.Range("B" & index).Value.ToString & vbNewLine & vbNewLine 'MsgBox((Blatt.Range("H" & index) Is Nothing)) 'MsgBox((Blatt.Range("H" & index).value Is Nothing)) If Blatt.Range("G" & index).value IsNot Nothing Then Allg &= "F-Beleg: " & Blatt.Range("G" & index).Value.ToString & vbNewLine If Blatt.Range("H" & index).value IsNot Nothing Then Allg &= "EUST-Konto: " & Blatt.Range("H" & index).Value.ToString & vbNewLine If Blatt.Range("I" & index).value IsNot Nothing Then Allg &= "ZOLL-Konto: " & Blatt.Range("I" & index).Value.ToString & vbNewLine If Blatt.Range("J" & index).value IsNot Nothing Then Allg &= "Zollamt: " & Blatt.Range("J" & index).Value.ToString & vbNewLine If Blatt.Range("K" & index).value IsNot Nothing Then If Allg <> "" Then Allg &= vbNewLine & "____________________________________________________________" & vbNewLine Allg &= Blatt.Range("K" & index).Value.ToString & vbNewLine End If If Blatt.Range("L" & index).value IsNot Nothing Then Allg &= Blatt.Range("L" & index).Value.ToString & vbNewLine If Blatt.Range("M" & index).value IsNot Nothing Then Allg &= Blatt.Range("M" & index).Value.ToString & vbNewLine If Blatt.Range("N" & index).value IsNot Nothing Then Allg &= Blatt.Range("N" & index).Value.ToString & vbNewLine If Blatt.Range("O" & index).value IsNot Nothing Then Allg &= Blatt.Range("O" & index).Value.ToString & vbNewLine If Blatt.Range("P" & index).value IsNot Nothing Then Allg &= Blatt.Range("P" & index).Value.ToString & vbNewLine KD.Besonderheiten = isleernothing(Allg.Trim) Dim obtmp = getTrimedStringACCES(AD.Ordnungsbegriff, 43) If AD.doesOrdnungsbegriffExist Then AD.Ordnungsbegriff = obtmp & " (UNISPED)" End If If AD.doesOrdnungsbegriffExist Then AD.Ordnungsbegriff = obtmp & " (UNISPED2)" End If If AD.doesOrdnungsbegriffExist Then AD.Ordnungsbegriff = obtmp & " (UNISPED3)" End If If AD.doesOrdnungsbegriffExist Then AD.Ordnungsbegriff = obtmp & " (UNISPED4)" End If If Blatt.Range("F" & index).value IsNot Nothing Then If Blatt.Range("F" & index).value.ToString.Length > 17 Then If Blatt.Range("F" & index).value IsNot Nothing Then Allg &= "Zoll-Nr.: " & Blatt.Range("F" & index).Value.ToString & vbNewLine Else KD.EORITIN = Blatt.Range("F" & index).Value.ToString.Replace(" ", "").Replace("/", "").Replace("-", "") End If End If KD.KundenNrZentrale = KD.KundenNr KD.FilialenNr = 5601 If KD.Sachbearbeiter = "" Then KD.Sachbearbeiter = "AUTO" KD.Währungscode = "EUR" KD.Eingegeben_am = Now.ToShortDateString ' AD.Ordnungsbegriff = getTrimedString(AD.Name_1 & "; " & AD.Ort, 50) If AD.Sachbearbeiter = "" Then AD.Sachbearbeiter = "AUTO" AD.Eingegeben_am = Now.ToShortDateString AD.LandKz = If(isleernothing(cProgramFunctions.getISO1Land(AD.LandKz)), AD.LandKz) AD.Rechnungsdruck = True If KD.EORITIN = "" 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 End If 'Item(0) = row(0) 'Item(1) = row(1) 'Dim NextListItem As New ListViewItem(Item) 'ListView1.Items.Add(NextListItem) Label14.Text = cnt & "/" & Blatt.UsedRange.Rows.Count cnt += 1 Me.Refresh() 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 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 Button28_Click(sender As Object, e As EventArgs) Handles Button28.Click VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = True VERAG_PROG_ALLGEMEIN.cSyska_Interface.OP_Einlesen_ALL(717858) VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = False End Sub Private Sub Button30_Click(sender As Object, e As EventArgs) Handles Button30.Click VERAG_PROG_ALLGEMEIN.cGoogleAPI.test() End Sub Private Sub Button33_Click(sender As Object, e As EventArgs) Handles Button33.Click Dim cnt = 0 Dim sql As New VERAG_PROG_ALLGEMEIN.SQL Dim kdnr_tmp = "" Try Dim fd As New OpenFileDialog If fd.ShowDialog = DialogResult.OK Then If fd.FileName.ToLower.EndsWith(".csv") Then ' fd.FileName.EndsWith(".csv") Using MyReader As New Microsoft.VisualBasic.FileIO.TextFieldParser(fd.FileName, Encoding.Default) MyReader.TextFieldType = FileIO.FieldType.Delimited MyReader.SetDelimiters(";") Dim currentRow As String() While Not MyReader.EndOfData Try ' currentRow = MyReader.ReadFields() If currentRow.Length > 2 Then If Not (currentRow(0).Trim() = "Teilnehmer") Then If currentRow.Length > 137 Then Dim DYIMPORT As New VERAG_PROG_ALLGEMEIN.cDY_Zollanmeldungen_Import() If Not DYIMPORT.hasEntry Then DYIMPORT.Teilnehmer = isleernothing((currentRow(0))) DYIMPORT.Anmeldeart_A = isleernothing((currentRow(1))) DYIMPORT.Verfahren = isleernothing((currentRow(2))) DYIMPORT.Bezugsnummer_LRN = isleernothing((currentRow(3))) DYIMPORT.Anlagedatum = isleernothing((currentRow(4))) DYIMPORT.Zeit = isleernothing((currentRow(5))) DYIMPORT.Zeitpunkt_der_letzten_CUSTAX = isleernothing((currentRow(6))) DYIMPORT.Überlassungsdatum = isleernothing((currentRow(7))) DYIMPORT.Annahmedatum = isleernothing((currentRow(8))) DYIMPORT.Registriernummer_MRN = isleernothing((currentRow(9))) DYIMPORT.Weitere_Reg_Nr = isleernothing((currentRow(10))) DYIMPORT.EDIFNR = isleernothing((currentRow(11))) DYIMPORT.Versendungsland = isleernothing((currentRow(12))) DYIMPORT.Art_der_Vertretung = isleernothing((currentRow(13))) DYIMPORT.Vertreter_des_Anmelders = isleernothing((currentRow(14))) DYIMPORT.Vertreter_AE_EORI = isleernothing((currentRow(15))) DYIMPORT.AE_Name = isleernothing((currentRow(16))) DYIMPORT.Versender_CZ_EORI = isleernothing((currentRow(17))) DYIMPORT.CZ_Code = isleernothing((currentRow(18))) DYIMPORT.CZ_Name = isleernothing((currentRow(19))) DYIMPORT.CZ_Ländercode = isleernothing((currentRow(20))) DYIMPORT.Empfänger_CN_EORI = isleernothing((currentRow(21))) DYIMPORT.CN_Code = isleernothing((currentRow(22))) DYIMPORT.CN_Name = isleernothing((currentRow(23))) DYIMPORT.CN_Ländercode = isleernothing((currentRow(24))) DYIMPORT.Anmelder_DT_EORI = isleernothing((currentRow(25))) DYIMPORT.DT_Code = isleernothing((currentRow(26))) DYIMPORT.DT_Name = isleernothing((currentRow(27))) DYIMPORT.DT_Ländercode = isleernothing((currentRow(28))) DYIMPORT.UstID_DT = isleernothing((currentRow(29))) DYIMPORT.Käufer_BY_Name = isleernothing((currentRow(30))) DYIMPORT.BY_EORI = isleernothing((currentRow(31))) DYIMPORT.Verkäufer_SL_Name = isleernothing((currentRow(32))) DYIMPORT.SL_EORI = isleernothing((currentRow(33))) DYIMPORT.ZollRechtlicherStatus = isleernothing((currentRow(34))) DYIMPORT.Bewilligungsnummer = isleernothing((currentRow(35))) DYIMPORT.Gesamtgewicht = IIf(isleernothing((currentRow(36))) <> "", CDbl(isleernothing(currentRow(36))), 0) DYIMPORT.Liefercode = isleernothing((currentRow(37))) DYIMPORT.Lieferort = isleernothing((currentRow(38))) DYIMPORT.Lieferkey = isleernothing((currentRow(39))) DYIMPORT.Geschäftsart = isleernothing((currentRow(40))) DYIMPORT.Rechnungsbetrag = IIf(isleernothing((currentRow(41))) <> "", CDbl(isleernothing(currentRow(41))), 0) DYIMPORT.Rechnungswährung = isleernothing((currentRow(42))) DYIMPORT.Rechnungskurs = IIf(isleernothing((currentRow(43))) <> "", CDbl(isleernothing(currentRow(43))), 0) DYIMPORT.Zollstelle = isleernothing((currentRow(44))) DYIMPORT.Aufschubart = isleernothing((currentRow(45))) DYIMPORT.HZAZoll = isleernothing((currentRow(46))) DYIMPORT.KontoZoll = isleernothing((currentRow(47))) DYIMPORT.TextZoll = isleernothing((currentRow(48))) DYIMPORT.EORIZoll = isleernothing((currentRow(49))) DYIMPORT.KennzeichenEigenZoll = isleernothing((currentRow(50))) DYIMPORT.ArtEust = isleernothing((currentRow(51))) DYIMPORT.HZAEust = isleernothing((currentRow(52))) DYIMPORT.KontoEusT = isleernothing((currentRow(53))) DYIMPORT.TextEust = isleernothing((currentRow(54))) DYIMPORT.EORIEust = isleernothing((currentRow(55))) DYIMPORT.KennzeichenEigenEust = isleernothing((currentRow(56))) DYIMPORT.Container = isleernothing((currentRow(57))) DYIMPORT.Unterlagenzeile = isleernothing((currentRow(58))) DYIMPORT.Unterlagenbereich = isleernothing((currentRow(59))) DYIMPORT.Unterlagenart = isleernothing((currentRow(60))) DYIMPORT.Unterlagennummer = isleernothing((currentRow(61))) DYIMPORT.Unterlagendatum = isleernothing((currentRow(62))) DYIMPORT.PositionNo = isleernothing((currentRow(63))) DYIMPORT.Positionen = isleernothing((currentRow(64))) DYIMPORT.Vorausstl_Zollabgabe = IIf(isleernothing((currentRow(65))) <> "", CDbl(isleernothing(currentRow(65))), 0) DYIMPORT.Vorausstl_Zollsatzabgabe = IIf(isleernothing((currentRow(66))) <> "", CDbl(isleernothing(currentRow(66))), 0) DYIMPORT.Vorausstl_Eustabgabe = IIf(isleernothing((currentRow(67))) <> "", CDbl(isleernothing(currentRow(67))), 0) DYIMPORT.Vorausstl_Eustsatzabgabe = IIf(isleernothing((currentRow(68))) <> "", CDbl(isleernothing(currentRow(68))), 0) DYIMPORT.Zollwert = IIf(isleernothing((currentRow(69))) <> "", CDbl(isleernothing(currentRow(69))), 0) DYIMPORT.AbgabeZoll = IIf(isleernothing((currentRow(70))) <> "", CDbl(isleernothing(currentRow(70))), 0) DYIMPORT.AbgabeZollsatz = IIf(isleernothing((currentRow(71))) <> "", CDbl(isleernothing(currentRow(71))), 0) DYIMPORT.Eustwert = IIf(isleernothing((currentRow(72))) <> "", CDbl(isleernothing(currentRow(72))), 0) DYIMPORT.AbgabeEust = IIf(isleernothing((currentRow(73))) <> "", CDbl(isleernothing(currentRow(73))), 0) DYIMPORT.AbgabeEustsatz = IIf(isleernothing((currentRow(74))) <> "", CDbl(isleernothing(currentRow(74))), 0) DYIMPORT.AbgabeAntidumping = IIf(isleernothing((currentRow(75))) <> "", CDbl(isleernothing(currentRow(75))), 0) DYIMPORT.AbgabeAntidumpingSatz = IIf(isleernothing((currentRow(76))) <> "", CDbl(isleernothing(currentRow(76))), 0) DYIMPORT.Status_Steuerbescheid = isleernothing((currentRow(77))) DYIMPORT.ArtikelCode = isleernothing((currentRow(78))) DYIMPORT.Warentarifnummer = isleernothing((currentRow(79))) DYIMPORT.Warenzusatz1 = isleernothing((currentRow(80))) DYIMPORT.Warenzusatz2 = isleernothing((currentRow(81))) DYIMPORT.Warenbezeichnung = isleernothing((currentRow(82))) DYIMPORT.Verfahren2 = isleernothing((currentRow(83))) DYIMPORT.EU_Code = isleernothing((currentRow(84))) DYIMPORT.Artikelpreis = IIf(isleernothing((currentRow(85))) <> "", CDbl(isleernothing(currentRow(85))), 0) DYIMPORT.Statistischerwert = IIf(isleernothing((currentRow(86))) <> "", CDbl(isleernothing(currentRow(86))), 0) DYIMPORT.Eust_manuell = IIf(isleernothing((currentRow(87))) <> "", CDbl(isleernothing(currentRow(87))), 0) DYIMPORT.Ursprung = isleernothing((currentRow(88))) DYIMPORT.Präferenzursprungsland = isleernothing((currentRow(89))) DYIMPORT.Beguenstigung = isleernothing((currentRow(90))) DYIMPORT.Rohmasse = IIf(isleernothing((currentRow(91))) <> "", CDbl(isleernothing(currentRow(91))), 0) DYIMPORT.Rohmasseeinheit = isleernothing((currentRow(92))) DYIMPORT.Eigenmasse = IIf(isleernothing((currentRow(93))) <> "", CDbl(isleernothing(currentRow(93))), 0) DYIMPORT.Eigenmasseeinheit = isleernothing((currentRow(94))) DYIMPORT.Positionszusatz = isleernothing((currentRow(95))) DYIMPORT.Aussenhandelstatistische_Menge = IIf(isleernothing((currentRow(96))) <> "", CDbl(isleernothing(currentRow(96))), 0) DYIMPORT.Maßeinheit = isleernothing((currentRow(97))) DYIMPORT.AnzahlPackstücke = IIf(isleernothing((currentRow(98))) <> "", CDbl(isleernothing(currentRow(98))), 0) DYIMPORT.Packstückart = isleernothing((currentRow(99))) DYIMPORT.Packstückbezeichnung = isleernothing((currentRow(100))) DYIMPORT.Zusätzliche_angaben = isleernothing((currentRow(101))) DYIMPORT.SonderAbgabeZoll = IIf(isleernothing((currentRow(102))) <> "", CDbl(isleernothing(currentRow(102))), 0) DYIMPORT.SonderAbgabeEust = IIf(isleernothing((currentRow(103))) <> "", CDbl(isleernothing(currentRow(103))), 0) DYIMPORT.AbgabeZusatzzölle = IIf(isleernothing((currentRow(104))) <> "", CDbl(isleernothing(currentRow(104))), 0) DYIMPORT.SonderAbgabeAntidumping = IIf(isleernothing((currentRow(105))) <> "", CDbl(isleernothing(currentRow(105))), 0) DYIMPORT.Verbrauchssteuern = IIf(isleernothing((currentRow(106))) <> "", CDbl(isleernothing(currentRow(106))), 0) DYIMPORT.Positionsunterlagenzeile = isleernothing((currentRow(107))) DYIMPORT.Positionsunterlagenbereich = isleernothing((currentRow(108))) DYIMPORT.Positionsunterlagenart = isleernothing((currentRow(109))) DYIMPORT.Positionsunterlagennummer = isleernothing((currentRow(110))) DYIMPORT.Positionsunterlagendatum = isleernothing((currentRow(111))) DYIMPORT.DV1Rechnungsbetrag = IIf(isleernothing((currentRow(112))) <> "", CDbl(isleernothing(currentRow(112))), 0) DYIMPORT.DV1Währung = isleernothing((currentRow(113))) DYIMPORT.DV1UmgerechnerterRechnungsbetrag = IIf(isleernothing((currentRow(114))) <> "", CDbl(isleernothing(currentRow(114))), 0) DYIMPORT.DV1UmgerechneteWährung = isleernothing((currentRow(115))) DYIMPORT.DV1Versicherung = IIf(isleernothing((currentRow(116))) <> "", CDbl(isleernothing(currentRow(116))), 0) DYIMPORT.DV1Versicherungswährung = isleernothing((currentRow(117))) DYIMPORT.DV1Luftfrachtkosten = IIf(isleernothing((currentRow(118))) <> "", CDbl(isleernothing(currentRow(118))), 0) DYIMPORT.DV1Luftfrachtwährung = isleernothing((currentRow(119))) DYIMPORT.DV1Frachtkosten = IIf(isleernothing((currentRow(120))) <> "", CDbl(isleernothing(currentRow(120))), 0) DYIMPORT.DV1Frachtwährung = isleernothing((currentRow(121))) DYIMPORT.DV1Materialien = IIf(isleernothing((currentRow(122))) <> "", CDbl(isleernothing(currentRow(122))), 0) DYIMPORT.DV1Materialwährung = isleernothing((currentRow(123))) DYIMPORT.DV1Provisionen = IIf(isleernothing((currentRow(124))) <> "", CDbl(isleernothing(currentRow(124))), 0) DYIMPORT.DV1Provisionwährung = isleernothing((currentRow(125))) DYIMPORT.Abflughafen_Code = isleernothing((currentRow(126))) DYIMPORT.Abflughafen_Text = isleernothing((currentRow(127))) DYIMPORT.Vorpapierart = isleernothing((currentRow(128))) DYIMPORT.Vorpapiere_Regnummer = isleernothing((currentRow(129))) DYIMPORT.BEAnteil_SumA = isleernothing((currentRow(130))) DYIMPORT.BEAnteil_ZL = IIf(isleernothing((currentRow(131))) <> "", CDbl(isleernothing(currentRow(131))), 0) DYIMPORT.BEAnteil_AV = IIf(isleernothing((currentRow(132))) <> "", CDbl(isleernothing(currentRow(132))), 0) DYIMPORT.UST_ID_Einführer = isleernothing((currentRow(133))) DYIMPORT.UST_ID_Erwerber = isleernothing((currentRow(134))) DYIMPORT.UST_ID_Fiskalvertreter = isleernothing((currentRow(135))) DYIMPORT.Shipmentnummer = isleernothing((currentRow(136))) DYIMPORT.Importstatus = isleernothing((currentRow(137))) If DYIMPORT.SAVE() Then TextBox10.Text &= DYIMPORT.Id & vbNewLine Else MsgBox("FEHLER: " & currentRow(2).Trim()) End If End If If cnt Mod 10 = 0 Then Application.DoEvents() Label10.Text = (cnt + 1) End If Else 'MsgBox(currentRow(2)) End If End If End If 'For Each currentField In currentRow cnt += 1 'Next Catch ex As Exception MsgBox(kdnr_tmp & " " & ex.Message & ex.StackTrace) End Try End While End Using End If End If Catch ex As Exception MessageBox.Show("Datei nicht vorhanden.") Finally End Try 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) ' If fi.Name >= 20190615 Then ' For Each f In System.IO.Directory.GetFiles(d) ' If cGetMsgType.isEZA_FreierVerkehrAktVeredelUmwandlungXML(doc) Then ' End If ' Next ' End If ' Next 'End Sub End Class Public Class cAviso Property AvisoID As Integer Property Datum As Date Property LKW_Nr As String Property Telefonisch As String Property Änderungen As String Property Info As String Property Status As Integer Property Auftraggeber As String Property Auftraggeber_KdNr As String = "" Property Frächter As String Property Frächter_KdNr As String = "" Property letzterMitarbeiter As String Property letzterMitarbeiterId As Object = Nothing Property Ankunft As Date Property Freigabe As Date Property Vorbereitet As Date Property Vorgeschrieben As Date Property Dauer As Integer Property AvisoEingang As Date Property Grenzstelle As String Property LKW_fertig As Boolean Property Handling As Boolean = False Property AvisoTVHinweis As String = "" Property Sendungen_Gesamtanzahl As Integer = 0 Property Sammelakt As Boolean = False Property Buero As String = "" Property ImEx As String = "" Property Abgeschlossen As Boolean = False Property FIRMA As String = VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA End Class ' _ 'Public Class arrays ' _ 'Property file As String 'End Class Public Class Files Public name As String Public Sub New() End Sub Public Sub New(ByVal name As String) Me.name = name End Sub End Class ' _ 'Public Class Files ' _ 'Public data As String 'End Class