Imports System.Data Imports System.Data.SqlClient Imports System.Data.SqlTypes Imports System.IO Imports System.Data.OleDb Public Class clsExcelImport Dim ofd As New OpenFileDialog Dim MyMsg As New Utils.MyMessage Dim Importdata As New DataSet Public Function Import_Excel() As Boolean ofd.Filter = "Excel-Dateien (*.xlsx)|*.xlsx|Excel-Dateien (*.xls)|*.xls|CSV-Dateien (*.csv)|*.csv|Text-Dateien (*.txt)|*.txt|Alle Dateien (*.*)|*.*" If ofd.ShowDialog() = DialogResult.Cancel Then Return False End If If ofd.FileName = "" Then Return False FillDataTableFromText(ofd.FileName) If Importdata.Tables.Count = 0 Then Return False Return True End Function Private Function FillDataTableFromText(ByVal file As String) As DataTable Select Case UCase(Microsoft.VisualBasic.Right(file, 3)) Case "CSV" Dim csv As New MyNameSpace.CSVDataAdapter(file, True, ";") csv.Fill(Importdata) Importdata.Tables(0).TableName = "ImportData" Case "TXT" Dim csv As New MyNameSpace.CSVDataAdapter(file, True, ";") csv.Fill(Importdata) 'Rel 4.03 3: Wenn die erste Spalte <> "Parternr" dann Meldung ausgeben und alle Rows löchen If Importdata.Tables(0).Columns(0).ColumnName <> "Partnernr" Then Importdata.Tables(0).Rows.Clear() End If Importdata.Tables(0).TableName = "ImportData" Case "XLS" If oledbimport(file, "XLS") Then Importdata.Tables(0).TableName = "ImportData" End If Case "XLSX" If oledbimport(file, "XLSX") Then Importdata.Tables(0).TableName = "ImportData" End If End Select If UCase(Microsoft.VisualBasic.Right(file, 5)) = ".XLSX" Then If oledbimport(file, "XLSX") Then Importdata.Tables(0).TableName = "ImportData" 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) Importdata.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) Importdata.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) Importdata.Tables.Add(dt) Return True Catch ex As Exception Return False 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 = Windows.Forms.DialogResult.OK Then Return f.ExcelSheet Else Return "" End If End Function Public Function Update_Data() Dim f As New frmDatenverarbeitung f.Show() 'f.TopMost = True f.ProgressBar1.Minimum = 0 f.ProgressBar1.Maximum = Importdata.Tables(0).Rows.Count f.ProgressBar1.Value = 0 f.txtResult.Text = "Personaldaten-Verarbeitung vom " + Now.ToShortDateString f.txtResult.AppendText(vbCrLf + "Start: " + Now.ToShortTimeString) f.txtResult.AppendText(vbCrLf + "----------------------") f.txtResult.AppendText(vbCrLf) Dim connection As New SqlConnection() connection.ConnectionString = Globals.sConnectionString Dim sqlcmd As New SqlCommand sqlcmd.CommandText = "dbo.update_personal_from_excel" sqlcmd.CommandType = CommandType.StoredProcedure Dim ErrorsExist As Boolean = False For Each dr As DataRow In Me.Importdata.Tables(0).Rows sqlcmd.Parameters.Clear() sqlcmd.Parameters.Add("@tgnummer", SqlDbType.VarChar) sqlcmd.Parameters.Add("@funktionstelle", SqlDbType.VarChar) sqlcmd.Parameters.Add("@Mutart", SqlDbType.VarChar) sqlcmd.Parameters.Add("@Name", SqlDbType.VarChar) sqlcmd.Parameters.Add("@Mutierer", SqlDbType.Int) sqlcmd.Parameters.Add("@resultat", SqlDbType.VarChar) sqlcmd.Parameters(0).Value = dr.Item(0) sqlcmd.Parameters(1).Value = dr.Item(2) sqlcmd.Parameters(2).Value = dr.Item(4) sqlcmd.Parameters(3).Value = dr.Item(1) sqlcmd.Parameters(4).Value = Globals.clsmitarbeiter.iMitarbeiternr.Value sqlcmd.Parameters(5).Value = "" sqlcmd.Parameters(5).Direction = ParameterDirection.Output sqlcmd.Parameters(5).Size = 1024 sqlcmd.Connection = connection connection.Open() Try sqlcmd.ExecuteNonQuery() Dim s As String = sqlcmd.Parameters(5).Value If s.IndexOf("Multiple::") > -1 Then f.txtResult.AppendText(Update_Manually(dr, s)) Else f.txtResult.AppendText(vbCrLf + sqlcmd.Parameters(5).Value) If Microsoft.VisualBasic.Left(sqlcmd.Parameters(5).Value, 1) = "N" Then ErrorsExist = True End If Catch ex As Exception f.txtResult.AppendText(vbCrLf + "Fehler: " + ex.Message) Finally connection.Close() End Try f.ProgressBar1.Value = f.ProgressBar1.Value + 1 Application.DoEvents() Next connection.Close() sqlcmd.Dispose() f.txtResult.AppendText(vbCrLf + "----------------------") f.txtResult.AppendText(vbCrLf + "Ende: " + Now.ToShortTimeString) f.ShowMessage(ErrorsExist) End Function Public Function Update_MassenData() Dim f As New frmDatenverarbeitung f.Show() 'f.TopMost = True f.ProgressBar1.Minimum = 0 f.ProgressBar1.Maximum = Importdata.Tables(0).Rows.Count f.ProgressBar1.Value = 0 f.txtResult.Text = "Massendaten-Verarbeitung vom " + Now.ToShortDateString f.txtResult.AppendText(vbCrLf + "Start: " + Now.ToShortTimeString) f.txtResult.AppendText(vbCrLf + "----------------------") f.txtResult.AppendText(vbCrLf) Dim connection As New SqlConnection() connection.ConnectionString = Globals.sConnectionString Dim sqlcmd As New SqlCommand sqlcmd.CommandText = "dbo.update_massendaten" sqlcmd.CommandType = CommandType.StoredProcedure Dim ErrorsExist As Boolean = False If Me.Importdata.Tables(0).Columns.Count < 21 Then For i = Me.Importdata.Tables(0).Columns.Count + 1 To 21 Me.Importdata.Tables(0).Columns.Add("F" + i.ToString) Next End If For Each dr As DataRow In Me.Importdata.Tables(0).Rows sqlcmd.Parameters.Clear() sqlcmd.Parameters.Add("@cmd", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f1", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f2", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f3", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f4", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f5", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f6", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f7", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f8", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f9", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f10", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f11", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f12", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f13", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f14", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f15", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f16", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f17", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f18", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f19", SqlDbType.VarChar) sqlcmd.Parameters.Add("@f20", SqlDbType.VarChar) sqlcmd.Parameters.Add("@Mutierer", SqlDbType.Int) sqlcmd.Parameters.Add("@resultat", SqlDbType.VarChar) sqlcmd.Parameters(0).Value = dr.Item(0).ToString sqlcmd.Parameters(1).Value = dr.Item(1).ToString sqlcmd.Parameters(2).Value = dr.Item(2).ToString sqlcmd.Parameters(3).Value = dr.Item(3).ToString sqlcmd.Parameters(4).Value = dr.Item(4).ToString sqlcmd.Parameters(5).Value = dr.Item(5).ToString sqlcmd.Parameters(6).Value = dr.Item(6).ToString sqlcmd.Parameters(7).Value = dr.Item(7).ToString sqlcmd.Parameters(8).Value = dr.Item(8).ToString sqlcmd.Parameters(9).Value = dr.Item(9).ToString sqlcmd.Parameters(10).Value = dr.Item(10).ToString sqlcmd.Parameters(11).Value = dr.Item(11).ToString sqlcmd.Parameters(12).Value = dr.Item(12).ToString sqlcmd.Parameters(13).Value = dr.Item(13).ToString sqlcmd.Parameters(14).Value = dr.Item(14).ToString sqlcmd.Parameters(15).Value = dr.Item(15).ToString sqlcmd.Parameters(16).Value = dr.Item(16).ToString sqlcmd.Parameters(17).Value = dr.Item(17).ToString sqlcmd.Parameters(18).Value = dr.Item(18).ToString sqlcmd.Parameters(19).Value = dr.Item(19).ToString sqlcmd.Parameters(20).Value = dr.Item(20).ToString sqlcmd.Parameters(21).Value = Globals.clsmitarbeiter.iMitarbeiternr.Value sqlcmd.Parameters(22).Value = "" sqlcmd.Parameters(22).Direction = ParameterDirection.Output sqlcmd.Parameters(22).Size = 1024 sqlcmd.Connection = connection connection.Open() Try sqlcmd.ExecuteNonQuery() Dim s As String = sqlcmd.Parameters(22).Value f.txtResult.AppendText(vbCrLf + sqlcmd.Parameters(22).Value) If Microsoft.VisualBasic.Left(sqlcmd.Parameters(22).Value, 1) = "N" Then ErrorsExist = True Catch ex As Exception f.txtResult.AppendText(vbCrLf + "Fehler: " + ex.Message) Finally connection.Close() End Try f.ProgressBar1.Value = f.ProgressBar1.Value + 1 Application.DoEvents() Next connection.Close() sqlcmd.Dispose() f.txtResult.AppendText(vbCrLf + "----------------------") f.txtResult.AppendText(vbCrLf + "Ende: " + Now.ToShortTimeString) f.ShowMessage(ErrorsExist) End Function Private Function Update_Manually(ByRef dr As DataRow, ByVal Resultattext As String) As String Resultattext = Resultattext.Substring(10, Len(Resultattext) - 10) Dim ma As String Dim Fs As String Dim dbc As New _DataClass.db.Personal dbc.sConnectionString = Globals.sConnectionString Dim dbf As New _DataClass.db.Funktionstelle dbf.sConnectionString = Globals.sConnectionString If dbc.get_mitarbeiter_by_tgnummer(dr.Item(0)) = True Then ma = dbc.sTGNummer.Value + " " + dbc.sName.Value End If Dim dt As New DataTable dt = dbc.get_funktionsbeziehungen(dbc.iPersonalnr) dt.Columns.Add("Sel", System.Type.GetType("System.Int32")) For Each r As DataRow In dt.Rows r.Item(4) = 1 Next If dbf.get_FunktionStelle_by_Funktionstelle(dr.Item(2)) Then Dim r As DataRow = dt.NewRow r.Item(0) = -1 r.Item(1) = dbf.iFunktionstelleNr.Value r.Item(2) = dbf.sFunktionsstelle.Value r.Item(3) = dbf.sBezeichnung.Value r.Item(4) = 0 dt.Rows.Add(r) End If Dim f As New frmUpdate(ma, dt) f.ShowDialog() If f.DialogResult = DialogResult.Abort Then Resultattext = vbCrLf + "NOK: " + Resultattext + "Manueller Abgleich durch Benutzer abgebrochen" Else Dim dbpf As New _DataClass.db.Personal_Funktionstelle dbpf.sConnectionString = Globals.sConnectionString For i = 0 To f.clb.Items.Count - 1 dbpf.Update_Data(dt.Rows(i).Item(0), dbc.iPersonalnr.Value, dt.Rows(i).Item(1), f.clb.GetItemCheckState(i)) Next Resultattext = vbCrLf + "OK: " + Resultattext + "Manueller Abgleich durchgeführt" End If Return Resultattext End Function End Class