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 frmMD Dim dsempfaenger As New DataSet Dim NOVA_Partnernr As String Dim Partnernr As String Dim PartnerKurzbezeichnung As String Dim Packagegroesse As String Dim DelayTime As String Private Sub BeendenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Me.Close() End Sub Private Function Generic_Select(ByVal bps As String, doktypes As String) As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim dbconn As New SqlConnection(Globals.sConnectionString) scmCmdToExecute.Connection = dbconn scmCmdToExecute.CommandText = "sp_dokmd" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim jvon As Integer Dim jbis As Integer If Trim(Me.txtJahrvon.Text) = "" Then jvon = 0 Else jvon = Me.txtJahrvon.Text If Trim(Me.txtJahrbis.Text) = "" Then jbis = 0 Else jbis = Me.txtJahrbis.Text scmCmdToExecute.Parameters.Add(New SqlParameter("@bps", SqlDbType.VarChar, 8000, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, bps)) scmCmdToExecute.Parameters.Add(New SqlParameter("@doktypes", SqlDbType.VarChar, 8000, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, doktypes)) scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try sdaAdapter.Fill(dtToReturn) Return dtToReturn Catch ex As Exception Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() End Try End Function Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Try Dim bps As String = "" Dim doktypes As String = "" For l_index As Integer = 0 To ListBox1.Items.Count - 1 If bps = "" Then bps = CStr(ListBox1.Items(l_index)) Else If Not ListBox1.Items(l_index) Is DBNull.Value Then If CStr(ListBox1.Items(l_index)).ToString <> "" Then bps = bps + ";" + CStr(ListBox1.Items(l_index)) End If End If Next For l_index As Integer = 0 To ListBox2.Items.Count - 1 If doktypes = "" Then doktypes = CStr(ListBox2.Items(l_index)) Else If Not ListBox2.Items(l_index) Is DBNull.Value Then If CStr(ListBox2.Items(l_index)).ToString <> "" Then doktypes = doktypes + ";" + CStr(ListBox2.Items(l_index)) End If End If Next Dim dt As New DataTable dt = Generic_Select(bps, doktypes) Me.DokList.DataSource = Nothing Me.DokList.DataSource = dt Me.DokList.DataMember = dt.TableName Me.Button2.Enabled = True Catch ex As Exception MsgBox(ex.Message) Me.Button2.Enabled = False End Try End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Partnernr = Me.txtBPNr.Text PartnerKurzbezeichnung = Me.Label5.Text Dim gendokCold As New Collection() Dim gendokOffice As New Collection Dim i As Integer Dim colRows As C1.Win.C1TrueDBGrid.SelectedRowCollection colRows = Me.DokList.SelectedRows If colRows.Count = 0 Then For i = 0 To Me.DokList.Splits(0).Rows.Count - 1 colRows.Add(i) Next End If 'Wenn mehr als ein Dokument selektiert ist dann Meldung zum Fragen anzeigen If colRows.Count > 1 Then If MsgBox("Alle markierten Dokumente (" + LTrim(Str(colRows.Count)) + ") drucken?", MsgBoxStyle.YesNo) = MsgBoxResult.No Then Exit Sub End If End If Me.Cursor = Cursors.WaitCursor Dim packagenr As Integer packagenr = CInt(Math.Truncate(colRows.Count / Packagegroesse)) packagenr = packagenr + 1 Dim f As New FrmDokMDSA_Fortschritt f.MdiParent = Me.MdiParent f.Show() f.ProgressBar1.Value = 0 f.ProgressBar1.Maximum = packagenr 'Loop über die Selektierten Dokumente und die Werte je nach Typ in eine Collection abspeichern Dim RowCunter As Integer = 0 For i = 0 To colRows.Count - 1 Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandText = "dbo.sp_check_dokument" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try scmCmdToExecute.Connection = conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.DokList.Columns("dokumentid").CellValue(colRows(i)))) scmCmdToExecute.Parameters.Add(New SqlParameter("@office", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.Parameters.Add(New SqlParameter("@cold", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) sdaAdapter.Fill(dtToReturn) 'Zuerst prüfen ob das Cold Bild vorhanden ist. If scmCmdToExecute.Parameters("@cold").Value > 0 Then 'DivFnkt.printcolddoc(Me.DokList.Columns("dokumentid").Value, Me, Me.DokList.Columns("dokumentid").Value) gendokCold.Add(New clsMehrfachdruck_Data(get_colddokumentid(Me.DokList.Columns("dokumentid").CellValue(colRows(i)), 0), NOVA_Partnernr, clsMehrfachdruck_Data.Enum_Typ.EDOKA, False, "", "", "", "")) Else If scmCmdToExecute.Parameters("@office").Value > 0 Then print_office(Me.DokList.Columns("dokumentid").CellValue(colRows(i)), Me) End If End If RowCunter = RowCunter + 1 Catch End Try 'Try ' 'Host Daten abfüllen ' gendokCold.Add(New clsMehrfachdruck_Data(Me.DokList.Columns("dokumentid").CellValue(colRows(i)), _ ' Me.DokList.Columns("partnernr_inhaber").CellValue(colRows(i)), clsMehrfachdruck_Data.Enum_Typ.HOST, False, _ ' Me.DokList.Columns("dokumenttypnr").CellValue(colRows(i)), "", _ ' Me.DokList.Columns("partnername_inhaber").CellValue(colRows(i)), _ ' Me.DokList.Columns("valutadatum").CellValue(colRows(i)))) ' RowCunter = RowCunter + 1 ' Exit Try 'Catch ex As Exception 'End Try If RowCunter > Packagegroesse - 1 Then f.ProgressBar1.Value = f.ProgressBar1.Value + 1 f.Label5.Text = "Druckauftrag " + f.ProgressBar1.Value.ToString + " von " + f.ProgressBar1.Maximum.ToString f.Label5.Text = f.Label5.Text + " - " + DelayTime.ToString + " Sekunden Wartezeit" Application.DoEvents() f.Refresh() f.BringToFront() f.Refresh() RowCunter = 0 fMehrfachdruck.DruckAnfrage(gendokCold, gendokOffice) f.Refresh() Application.DoEvents() gendokCold.Clear() Application.DoEvents() f.Refresh() Dim t1 As DateTime Dim t2 As DateTime Threading.Thread.CurrentThread.Sleep(DelayTime * 1000) gendokCold.Clear() End If Next Try If gendokCold.Count > 0 Then fMehrfachdruck.DruckAnfrage(gendokCold, gendokOffice) Application.DoEvents() Catch ex As Exception Finally Me.Cursor = Cursors.Default End Try f.Close() f.Dispose() End Sub Public Function get_colddokumentid(ByVal dokumentid As String, ByVal fnkt As Integer) As String Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandText = "dbo.sp_get_colddokumentid" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) scmCmdToExecute.Connection = conn.scoDBConnection Try scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid)) scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, fnkt)) scmCmdToExecute.Parameters.Add(New SqlParameter("@colddokumentid", SqlDbType.VarChar, 255, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, "")) scmCmdToExecute.Parameters.Add(New SqlParameter("@coldpartnernr", SqlDbType.VarChar, 255, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, "")) sdaAdapter.Fill(dtToReturn) Me.Nova_Partnernr = scmCmdToExecute.Parameters("@coldpartnernr").Value get_colddokumentid = scmCmdToExecute.Parameters("@colddokumentid").Value Catch ex As Exception MsgBox("Status Dokumentbearbeitung::" & scmCmdToExecute.CommandText + "::" + ex.Message) Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() dtToReturn.Dispose() End Try End Function Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click Dim f As New FrmPartnersuche f.ShowDialog() If f.PartnerNr <> 0 Then Me.txtBPNr.Text = f.PartnerNr Update_BP() End If End Sub Private Sub txtBPNr_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles txtBPNr.KeyDown If e.KeyCode = Keys.Enter Then Update_BP() End If End Sub Private Sub txtBPNr_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtBPNr.Leave Update_BP() End Sub Private Sub Update_BP() Try Dim f As New FrmPartnersuche f.Partner_Suche(Me.txtBPNr.Text) If f.PartnerKurzbezeichnnung = "" Then MsgBox("Eingegebener Parter ist nicht vorhanden", MsgBoxStyle.Critical) Me.Label5.Text = "[Kein Partner ausgwählt]" Me.Button1.Enabled = False Me.Button2.Enabled = False Else Me.Label5.Text = f.PartnerKurzbezeichnnung Me.Button1.Enabled = True Me.Button2.Enabled = False End If Catch End Try End Sub Private Sub ToolStripButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton1.Click Me.Close() End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.Button1.Enabled = True Me.Packagegroesse = DivFnkt.Get_Office_2010_Param(31) Me.DelayTime = DivFnkt.Get_Office_2010_Param(32) End Sub Private Sub txtBPNr_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtBPNr.TextChanged End Sub Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click dsempfaenger.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 Me.ListBox1.Items.Clear() FillDataTableFromText(Me.OpenFileDialog1.FileName) Try For Each R As DataRow In dsempfaenger.Tables(0).Rows Me.ListBox1.Items.Add(R.Item(0)) Next Catch End Try End Sub 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(Me.dsempfaenger) 'Rel 4.03 3: Wenn die erste Spalte <> "Parternr" dann Meldung ausgeben und alle Rows löchen Me.dsempfaenger.Tables(0).TableName = "empfdatatable" Case "TXT" Dim csv As New MyNameSpace.CSVDataAdapter(file, True, ";") csv.Fill(Me.dsempfaenger) 'Rel 4.03 3: Wenn die erste Spalte <> "Parternr" dann Meldung ausgeben und alle Rows löchen Me.dsempfaenger.Tables(0).TableName = "empfdatatable" Case "XLS" If oledbimport(file, "XLS") Then Me.dsempfaenger.Tables(0).TableName = "empfdatatable" End If Case "XLSX" If oledbimport(file, "XLSX") Then Me.dsempfaenger.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.dsempfaenger.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.dsempfaenger.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.dsempfaenger.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.dsempfaenger.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 = Windows.Forms.DialogResult.OK Then Return f.ExcelSheet Else Return "" End If End Function Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click dsempfaenger.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 Me.ListBox2.Items.Clear() FillDataTableFromText(Me.OpenFileDialog1.FileName) Try For Each R As DataRow In dsempfaenger.Tables(0).Rows Me.ListBox2.Items.Add(R.Item(0)) Next Catch End Try End Sub Public Function Open_Directory() As Boolean Open_Directory = True End Function Public Function Get_Filename(ByVal fi As String, ByVal partnernr As String) As String Dim s As String Get_Filename = "" If Not Open_Directory() Then Exit Function s = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") Get_Filename = s + fi End Function Public Sub print_office(ByVal dokumentid As String, ByVal formx As Form, Optional ByVal ShowPrintMessage As Boolean = True) Try Dim doc As New edokadb.clsDokument Dim Dokument As String Dim FileReader As New DocMgmt() doc.cpMainConnectionProvider = conn doc.sDokumentid = New SqlString(CType(dokumentid, String)) doc.SelectOne() Dokument = Get_Filename(doc.sDokumentname.Value, "") If FileReader.Get_From_DB(doc.sDokumentid.Value, Dokument) = False Then 'If BDR_Dokument(dokumentid) Then ' MyMsg.show_standardmessage(240, MsgBoxStyle.Information) 'Else ' MyMsg.show_standardmessage(39, MsgBoxStyle.Information) 'End If doc.Dispose() FileReader = Nothing Exit Sub End If doc.Dispose() FileReader = Nothing 'Office_2010 Dim EXT As String = System.IO.Path.GetExtension(Dokument) Select Case UCase(EXT.Substring(0, 3)) Case ".DO" Dim objword As Microsoft.Office.Interop.Word.Application objword = CreateObject("Word.Application") Try Thread.Sleep(1000) objword.Run("Autoexec") Catch ex As Exception End Try objword.Documents.Open(Dokument) Threading.Thread.CurrentThread.Sleep(500) Dim ierror As Integer = 0 Try objword.Visible = True objword.WindowState = Microsoft.Office.Interop.Word.WdWindowState.wdWindowStateNormal Thread.CurrentThread.Sleep(3000) objword.Documents(1).Activate() objword.Activate() Application.DoEvents() objword.Run("BackGroundPrint") Thread.CurrentThread.Sleep(3000) Application.DoEvents() objword.Visible = False 'objword.WindowState = Microsoft.Office.Interop.Word.WdWindowState.wdWindowStateNormal Catch ex As Exception objword.Visible = False ierror = 1 MsgBox("Das Dokument konnte nicht gedruckt werden." + vbCrLf + vbCrLf + ex.Message) End Try Threading.Thread.CurrentThread.Sleep(500) objword.ActiveDocument.Close(SaveChanges:=False) objword.Quit() objword = Nothing objword = Nothing If ierror <> 0 Then Exit Select Exit Sub Case ".XL" Dim xls As New Microsoft.Office.Interop.Excel.Application xls.Workbooks.Open(Dokument) xls.ActiveWorkbook.Sheets.Select() xls.ActiveWindow.SelectedSheets.PrintOutEx(Copies:=1) xls.ActiveWorkbook.Close(SaveChanges:=False) xls.Quit() xls = Nothing Exit Sub Case Else Process.Start(Dokument) End Select Exit Sub Catch 'MyMsg.show_standardmessage(92, MsgBoxStyle.Critical) End Try End Sub End Class