You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

292 lines
10 KiB

Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Imports System.ComponentModel
Imports System.Drawing
Imports System.Drawing.Color
Imports System.IO
Imports System.Threading
Imports System.Windows.Forms
Imports System.Data.OleDb
Public Class Form1
Dim dsdaten As New DataSet
Dim HasErrors As Boolean = False
Dim HasError As Boolean = False
Dim db As New DB
Dim Resulttext As String = ""
Dim dbconn As New DB_Connection
Private Sub SchliessenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SchliessenToolStripMenuItem.Click
Me.Close()
End Sub
Private Sub ExcelImportToolStripMenuItem_Click(sender As Object, e As EventArgs)
End Sub
Private Function FillDataTableFromText(ByVal file As String) As DataTable
Select Case UCase(Microsoft.VisualBasic.Right(file, 3))
Case "XLS"
If oledbimport(file, "XLS") Then
Me.dsdaten.Tables(0).TableName = "empfdatatable"
End If
Case "XLSX"
If oledbimport(file, "XLSX") Then
Me.dsdaten.Tables(0).TableName = "empfdatatable"
End If
End Select
'Rel. Office Migration
If UCase(Microsoft.VisualBasic.Right(file, 5)) = ".XLSX" Then
If oledbimport(file, "XLSX") Then
Me.dsdaten.Tables(0).TableName = "empfdatatable"
End If
End If
Dim dv As DataRow
End Function
Private Function oledbimport(ByVal file As String, ByVal filetype As String) As Boolean
Dim dt As New DataTable()
Dim conn As OleDbConnection
Dim sql As String
Dim FileConnection As String
Dim oda As New OleDbDataAdapter()
Dim msg As String
Select Case filetype
Case "XLS"
Try
Dim xls As New XLSLib.clsXLSLib
dt = xls.Get_Excel(file)
Me.dsdaten.Tables.Add(dt)
Return True
Catch ex As Exception
MsgBox(ex.Message)
End Try
Case "XLSX"
Try
Dim xls As New XLSLib.clsXLSLib
dt = xls.Get_Excel(file)
Me.dsdaten.Tables.Add(dt)
Return True
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Select
Try
Try
conn = New OleDbConnection()
conn.ConnectionString = FileConnection
conn.Open()
Catch ex As Exception
msg = ex.Message
End Try
oda = New OleDbDataAdapter(sql, conn)
oda.Fill(dt)
'Rel 4.03 4: Sofern die erste Spalte der importierten Daten keine Partnernummer ist, Meldung ausgeben
Me.dsdaten.Tables.Add(dt)
Return True
Catch ex As Exception
Finally
oda.Dispose()
conn.Dispose()
End Try
End Function
Private Function Get_Sheetname(ByVal excelfile As String) As String
Dim f As New frmExcelSheets
f.ExcelFile = excelfile
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
Return f.ExcelSheet
Else
Return ""
End If
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Sub VerarbeitenToolStripMenuItem_Click(sender As Object, e As EventArgs)
End Sub
Sub check_doktyp(ByVal doktypnr As Integer)
If db.Get_DokumentTYP(doktypnr) = False Then
Resulttext = Resulttext + vbCrLf + "Dokumenttyp Nr: " + doktypnr.ToString + " nicht vorhanden"
HasError = True
End If
End Sub
Sub Check_Ma(ByVal Manr As Integer)
If db.Get_Mitarbeiter(Manr) = False Then
Resulttext = Resulttext + vbCrLf + "Mitarbeiter Nr: " + Manr.ToString + " nicht vorhanden order inaktiv"
HasError = True
End If
End Sub
Sub update_doktyp_ma(ByVal doktypnr As Integer, ByVal manr As Integer)
If db.Update_Doktype(doktypnr, manr) = False Then
Resulttext = Resulttext + vbCrLf + "Update Dokumenttyp Nr: " + doktypnr.ToString + " fehlerhaft"
HasError = True
Else
Resulttext = Resulttext + vbCrLf + "Update Dokumenttyp Nr: " + doktypnr.ToString + " durchgeführt"
End If
End Sub
Sub check_office_vorlage(ByVal ovnr As Integer)
If db.Get_ov(ovnr) = False Then
Resulttext = Resulttext + vbCrLf + "Office-Vorlage Nr: " + ovnr.ToString + " nicht vorhanden"
HasError = True
End If
End Sub
Sub Update_Office_Vorlage(ByVal ovnr As Integer, ByVal manr As Integer)
If db.Update_Officevorlage(ovnr, manr) = False Then
Resulttext = Resulttext + vbCrLf + "Update Office-Vorlage Nr: " + ovnr.ToString + " fehlerhaft"
HasError = True
Else
Resulttext = Resulttext + vbCrLf + "Update Office-Vorlage Nr: " + ovnr.ToString + " durchgeführt"
End If
End Sub
Private Sub ExcelImportToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles ExcelImportToolStripMenuItem1.Click
get_exceldata()
Me.OfficeVoralgeOwnerToolStripMenuItem.Enabled = False
If Me.C1Daten.Splits(0).Rows.Count > 0 Then Me.VerarbeitenToolStripMenuItem1.Enabled = True
End Sub
Sub get_exceldata()
dsdaten.Tables.Clear()
Me.OpenFileDialog1.Filter = "Excel-Dateien (*.xlsx)|*.xlsx|Excel-Dateien (*.xls)|*.xls|CSV-Dateien (*.csv)|*.csv|Text-Dateien (*.txt)|*.txt|Alle Dateien (*.*)|*.*"
Me.OpenFileDialog1.FileName = ""
Me.OpenFileDialog1.ShowDialog()
If Me.OpenFileDialog1.FileName = "" Then Exit Sub
FillDataTableFromText(Me.OpenFileDialog1.FileName)
Try
Me.C1Daten.DataSource = Nothing
Me.C1Daten.DataSource = dsdaten.Tables(0)
Me.C1Daten.DataMember = dsdaten.Tables(0).TableName
Me.HasErrors = False
Me.HasError = False
Me.txtResultat.Text = ""
Me.Resulttext = ""
Catch
End Try
End Sub
Private Sub VerarbeitenToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles VerarbeitenToolStripMenuItem1.Click
For Each r As DataRow In Me.dsdaten.Tables(0).Rows
check_doktyp(r.Item(0))
Check_Ma(r.Item(1))
'Check_Ma(r.Item(2))
If HasError Then
HasErrors = True
HasError = False
End If
Next
If HasErrors Then
Me.Resulttext = Me.Resulttext + vbCrLf + vbCrLf + "Verarbeitung aufgrund von Fehlern nicht durchgeführt."
Me.txtResultat.Text = Me.Resulttext
Exit Sub
End If
'For Each r As DataRow In Me.dsdaten.Tables(0).Rows
' check_doktyp_ma(r.Item(0), r.Item(1))
' If HasError Then
' HasErrors = True
' HasError = False
' End If
'Next
'If HasErrors Then
' Me.Resulttext = Me.Resulttext + vbCrLf + vbCrLf + "Verarbeitung aufgrund von Fehlern nicht durchgeführt."
' Me.txtResultat.Text = Me.Resulttext
' Exit Sub
'End If
For Each r As DataRow In Me.dsdaten.Tables(0).Rows
update_doktyp_ma(r.Item(0), r.Item(1))
If HasError Then
HasErrors = True
HasError = False
End If
Next
If HasErrors Then
Me.Resulttext = Me.Resulttext + vbCrLf + vbCrLf + "Verarbeitung aufgrund von Fehlern nicht durchgeführt."
Me.txtResultat.Text = Me.Resulttext
Exit Sub
End If
Me.Resulttext = Me.Resulttext + vbCrLf + vbCrLf + "Verarbeitung durchgeführt."
Me.txtResultat.Text = Me.Resulttext
End Sub
Private Sub ExcelImportToolStripMenuItem_Click_1(sender As Object, e As EventArgs) Handles ExcelImportToolStripMenuItem.Click
get_exceldata()
DokumenttypOwnerToolStripMenuItem.Enabled = False
If Me.C1Daten.Splits(0).Rows.Count > 0 Then Me.VerarbeitenToolStripMenuItem2.Enabled = True
End Sub
Private Sub VerarbeitenToolStripMenuItem2_Click(sender As Object, e As EventArgs) Handles VerarbeitenToolStripMenuItem2.Click
For Each r As DataRow In Me.dsdaten.Tables(0).Rows
check_Office_Vorlage(r.Item(0))
Check_Ma(r.Item(1))
'Check_Ma(r.Item(2))
If HasError Then
HasErrors = True
HasError = False
End If
Next
If HasErrors Then
Me.Resulttext = Me.Resulttext + vbCrLf + vbCrLf + "Verarbeitung aufgrund von Fehlern nicht durchgeführt."
Me.txtResultat.Text = Me.Resulttext
Exit Sub
End If
'For Each r As DataRow In Me.dsdaten.Tables(0).Rows
' check_doktyp_ma(r.Item(0), r.Item(1))
' If HasError Then
' HasErrors = True
' HasError = False
' End If
'Next
'If HasErrors Then
' Me.Resulttext = Me.Resulttext + vbCrLf + vbCrLf + "Verarbeitung aufgrund von Fehlern nicht durchgeführt."
' Me.txtResultat.Text = Me.Resulttext
' Exit Sub
'End If
For Each r As DataRow In Me.dsdaten.Tables(0).Rows
Update_Office_Vorlage(r.Item(0), r.Item(1))
If HasError Then
HasErrors = True
HasError = False
End If
Next
If HasErrors Then
Me.Resulttext = Me.Resulttext + vbCrLf + vbCrLf + "Verarbeitung aufgrund von Fehlern nicht durchgeführt."
Me.txtResultat.Text = Me.Resulttext
Exit Sub
End If
Me.Resulttext = Me.Resulttext + vbCrLf + vbCrLf + "Verarbeitung durchgeführt."
Me.txtResultat.Text = Me.Resulttext
End Sub
End Class