Imports System.IO Imports System.Data.SqlClient Imports System.Data.SqlTypes Imports Microsoft.Office.Interop Imports Syncfusion.Pdf.Parsing Imports Syncfusion.Pdf Module Main #Region "Deklarationen" Dim dsempfaenger As New DataSet() Dim db As New EDOKA.DB_Connection() Dim vorlagendaten As New DataTable() Dim serienbriefnr As Integer = 29 'Dim objword As New Word.ApplicationClass() Dim objword As New Word.Application() Dim beginntextmarke As String Dim endetextmarke As String Dim feldname As String Dim dokid As String Dim blkunde As String = "" Dim doktyp As New edokadb.clsDokumenttyp() Dim officevorlage As New edokadb.clsOffice_vorlage() Dim serienbrief As New edokadb.clsEdex_sb_serienbrief() Dim applikationsdaten As New edokadb.clsApplikation() Dim GenerierteDokumente As New Collection() Dim GenerierteBLDokumente As New Collection() 'Dim BMSMail As New Common.Common Dim PrintDokName As String = "" Dim MailText As String = "" #End Region Sub mergetest() Dim files As String() = Directory.GetFiles("d:\edoka\edkB09\pdf") Dim file1 As String() ReDim file1(100) For i As Integer = 0 To 100 file1(i) = files(i) Next Dim document As New PdfDocument() document.EnableMemoryOptimization = True For Each inputDocument As String In file1 Dim loadedDocument As New PdfLoadedDocument(inputDocument) loadedDocument.EnableMemoryOptimization = True document.ImportPageRange(loadedDocument, 0, loadedDocument.Pages.Count - 1) loadedDocument.Close(True) Next document.Save("d:\edoka\edkb09\Output.pdf") document.Close() Exit Sub Dim s As String s = files(0) Dim document1 As New PdfLoadedDocument(s) 'document1.Save("d:\edoka\edkb09\ds1.pdf") For i As Integer = 0 To 100 s = files(i) Dim document2 As New PdfLoadedDocument(s) document1.Append(document2) document2.Close(True) Next document1.Save("d:\edoka\edkb09\ds1.pdf") document1.Close(True) 'Exit Sub 'Dim document As New PdfDocument() 'document.EnableMemoryOptimization = True 'For Each inputDocument As String In files ' Dim loadedDocument As New PdfLoadedDocument(inputDocument) ' loadedDocument.EnableMemoryOptimization = True ' document.ImportPageRange(loadedDocument, 0, loadedDocument.Pages.Count - 1) ' loadedDocument.Close(True) 'Next 'document.Save("d:\edoka\edkb09\Output.pdf") 'document.Close() End Sub Dim d1, d2 As DateTime Dim FileExtension As String = "" Function Check_Status() As Boolean Dim s As String = "" Try FileOpen(2, Params.Pfad_Serienbrief_Daten + "RunStatus.txt", OpenMode.Input) Input(2, s) FileClose(2) s = RTrim(LTrim(s)) If s = "1" Then Return False Else Return True End If Catch ex As Exception End Try End Function Function Set_Status(statusnr As String) FileOpen(2, Params.Pfad_Serienbrief_Daten + "RunStatus.txt", OpenMode.Output) WriteLine(2, statusnr) FileClose(2) End Function Sub Main() If Check_Status() = False Then Exit Sub Set_Status("1") 'mergetest() 'Exit Sub ''Dim inputFile As String ''Dim inputFileFullPath As String ''Dim fi As FileInfo ''Dim dir As New DirectoryInfo("c:\edokatemp\ps\out") ''Dim p As Integer = 0 ''Dim s As String ''For Each fi In dir.GetFiles '' s = fi.Name '' s = Left(s, Len(s) - 4) '' GenerierteDokumente.Add(New DruckJobData(s, "", 0, 0, 0, "")) ''Next ''serienbriefnr = 198 ''Create_Printjob() Console.WriteLine(Params.Office2010) Try Globals.BMS_Log(Globals.BMS_Fnkt.BMSStart) applikationsdaten.cpMainConnectionProvider = Globals.conn_edoka applikationsdaten.iApplikationsnr = New SqlInt32(CType(1, Int32)) Globals.Applikationsdaten = applikationsdaten.SelectOne Dim sb As New DataTable sb = get_serienbriefe() Dim i As Integer Dim ii As Integer = 0 For i = 0 To sb.Rows.Count - 1 Try serienbriefnr = sb.Rows(i).Item(0) Console.WriteLine("Serienbriefnr:" + serienbriefnr.ToString) MailText = MailText + vbCrLf + serienbriefnr.ToString Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Start Serienbrief " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Information) 'Nur starten, sofern es vor 0400 ist generieren() Do While GenerierteDokumente.Count > 0 GenerierteDokumente.Remove(1) Loop Do While GenerierteBLDokumente.Count > 0 GenerierteBLDokumente.Remove(1) Loop Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Ende Serienbrief " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Information) Catch ex As Exception Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, +"EDKB09: " + ex.Message, Globals.Enum_BMS_Typen.Fehler) Finally Try Globals.conn_edoka.CloseConnection(True) Catch ex As Exception Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, +"EDKB09: " + ex.Message, Globals.Enum_BMS_Typen.Fehler) End Try End Try Next Catch ex As Exception Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: " + ex.Message, Globals.Enum_BMS_Typen.Fehler) Finally Try objword.Quit(False) objword = Nothing Catch End Try Globals.BMS_Log(Globals.BMS_Fnkt.BMSStop) Sendmail(Params.MailEmpfanger, 0, 0) End Try d2 = Now Set_Status("0") 'BMSMail.SendMail(Params.MailEmpfanger, "EDKB09 beendet", "EDKB09 beendet") End Sub Dim savestatus As Integer Private Sub generieren() Try serienbrief.cpMainConnectionProvider = Globals.conn_edoka serienbrief.iSerienbriefnr = New SqlInt32(CType(serienbriefnr, Int32)) serienbrief.SelectOne() savestatus = serienbrief.iStatus.Value 'Empfängerklasse Instanzieren und Empfängerdaten auslesen Dim clsempf As New clsEmpfaengerdata(dsempfaenger, serienbriefnr) Try clsempf.Get_Empfaenger() If Hour(Now) > 5 And Hour(Now) < 21 Then 'zwischen 0500 und 2100 nur Kleinmengen abarbeiten If dsempfaenger.Tables(0).Rows.Count > Params.Anzahl_Dokumente_Kleinauftrag Then Exit Sub End If End If Catch End Try 'If serienbrief.iAusgeloest.Value = 0 And serienbrief.iBestaetigt.Value = 0 Then ' Exit Sub 'End If Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Daten aufbereiten Start: SB " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Information) vorlagendaten = clsempf.Vorlagendaten_aufbreiten() Vorlage_Auslesen(serienbriefnr) Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Daten aufbereiten Ende: SB " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Information) Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Dokumente generieren Start: SB " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Information) Dokumente_Generieren() Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Dokumente generieren Ende: SB " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Information) ' Generierte Dokument wegkopieren und Druckjobs erstellen Try Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Druckjob aufbereiten Start: SB " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Information) Create_Printjob() Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Druckjob aufbereiten Ende: SB " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Information) Catch ex As Exception Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Druckjobgenerierung: " + serienbriefnr.ToString + ": " + ex.Message, Globals.Enum_BMS_Typen.Warnung) End Try 'Bestätigte Dokumente für Import Bereitstellen Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Daten für EDKB08 aufbereiten Start: SB " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Information) Dim ci As New clsImportData(dsempfaenger, serienbriefnr, serienbrief) ci.Create_Import_Data() ci = Nothing Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Daten für EDKB08 aufbereiten Ende: SB " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Information) If savestatus = 1 Then Datensatz_Zaehler_Aktualisieren() serienbrief.iStatus = New SqlInt32(CType(2, Int32)) Globals.conn_edoka.OpenConnection() serienbrief.Update() Globals.conn_edoka.CloseConnection(True) Else Datensatz_Zaehler_Aktualisieren() Globals.conn_edoka.OpenConnection() serienbrief.Update() Globals.conn_edoka.CloseConnection(True) End If dsempfaenger.Tables("UsedFelder").Columns.Remove("TempFeldname") dsempfaenger.Tables("UsedFelder").Columns.Remove("Fnkt") dsempfaenger.Tables(0).PrimaryKey = Nothing dsempfaenger.Tables(0).Columns.Remove("IntEintragnr") clsempf.save() Catch ex As Exception Try Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: " + ex.Message, Globals.Enum_BMS_Typen.Fehler) Catch ex1 As Exception End Try Finally End Try End Sub Private Sub Datensatz_Zaehler_Aktualisieren() Dim iFehlerhaft As Integer Dim iNichtgeneriert As Integer Dim iAusgeloest As Integer Dim iErstellt As Integer Dim iGedruckt As Integer Dim iBestaetigt As Integer Dim dv As DataRow() Dim DR As DataRow dv = dsempfaenger.Tables(0).Select("Status='-1'") iFehlerhaft = 0 For Each DR In dv iFehlerhaft = iFehlerhaft + 1 Next iNichtgeneriert = 0 dv = dsempfaenger.Tables(0).Select("Status='0' or Status=''") For Each DR In dv iNichtgeneriert = iNichtgeneriert + 1 Next iAusgeloest = 0 dv = dsempfaenger.Tables(0).Select("Status='1'") For Each DR In dv iAusgeloest = iAusgeloest + 1 Next iErstellt = 0 dv = dsempfaenger.Tables(0).Select("Status='2'") For Each DR In dv iErstellt = iErstellt + 1 Next iGedruckt = 0 dv = dsempfaenger.Tables(0).Select("Status='3'") For Each DR In dv iGedruckt = iGedruckt + 1 Next iBestaetigt = 0 dv = dsempfaenger.Tables(0).Select("Status='4'") For Each DR In dv iBestaetigt = iBestaetigt + 1 Next serienbrief.iFehlerhaft = New SqlInt32(CType(iFehlerhaft, Int32)) serienbrief.iInBearbeitung = New SqlInt32(CType(iNichtgeneriert, Int32)) serienbrief.iErstellt = New SqlInt32(CType(iErstellt, Int32)) serienbrief.iGedruckt = New SqlInt32(CType(iGedruckt, Int32)) serienbrief.iBestaetigt = New SqlInt32(CType(iBestaetigt, Int32)) serienbrief.iAusgeloest = New SqlInt32(CType(iAusgeloest, Int32)) End Sub Private Function get_serienbriefe() As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) scmCmdToExecute.CommandText = "dbo.sp_edex_sb_get_for_print" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = Globals.conn_edoka.scoDBConnection Try sdaAdapter.Fill(dtToReturn) Return dtToReturn Catch ex As Exception Throw New Exception("sp_check_dokumentreaktivierung::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() End Try End Function #Region "Dokument generieren" 'Private Function Dokumente_Generieren() ' Dim Kopfzeile As Boolean ' serienbrief.cpMainConnectionProvider = Globals.conn_edoka ' serienbrief.iSerienbriefnr = New SqlInt32(CType(serienbriefnr, Int32)) ' serienbrief.SelectOne() ' doktyp.cpMainConnectionProvider = Globals.conn_edoka ' doktyp.iDokumenttypnr = serienbrief.iDokumenttypnr ' doktyp.SelectOne() ' officevorlage.cpMainConnectionProvider = Globals.conn_edoka ' officevorlage.iOffice_vorlagenr = doktyp.iOffice_vorlagenr ' officevorlage.SelectOne() ' If officevorlage.bKopfzeile_generieren.Value = True Then ' Kopfzeile = True ' Else ' Kopfzeile = False ' End If ' serienbrief.Dispose() ' doktyp.Dispose() ' officevorlage.Dispose() ' objword = New Word.ApplicationClass() ' objword.WindowState = Word.WdWindowState.wdWindowStateMinimize ' objword.Visible = False ' Dim i As Integer ' Dim i1 As Integer ' Dim pstep As Double ' Dim pval As Double ' Dim feldnr As String ' Try ' pstep = 70 / vorlagendaten.Rows.Count ' Catch ' pval = 30 ' End Try ' For i = 0 To vorlagendaten.Rows.Count - 1 ' Try ' pval = pval + pstep ' Dim dokumentname = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + serienbriefnr.ToString + "_vorlage.doc" ' objword.Documents.Open(dokumentname) ' objword.Visible = False ' objword.WindowState = Word.WdWindowState.wdWindowStateMinimize ' If Kopfzeile Then ' Insert_Kopfzeile() ' End If ' Dim sp1 As String ' Dim sp2() As String ' For i1 = 0 To vorlagendaten.Columns.Count - 1 ' Try ' sp1 = vorlagendaten.Columns(i1).ColumnName ' sp2 = sp1.Split("_09_") ' sp1 = sp2(0) + "_09_" + sp2(1) ' feldnr = sp2(1).ToString ' sp1 = sp1 ' Catch ' sp1 = vorlagendaten.Columns(i1).ColumnName ' feldnr = sp1 ' End Try ' Select Case sp1 ' 'Mapping Zustelladresse ' Case "F_09_1", "F_09_10" ' If vorlagendaten.Rows(i).Item("Zustelladresse") <> "" Then ' vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Zustelladresse") ' End If ' Case "F_09_89" ' If vorlagendaten.Rows(i).Item("Name") <> "" Then ' vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Name") ' End If ' Case "F_09_111" ' If vorlagendaten.Rows(i).Item("Vorname") <> "" Then ' vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Vorname") ' End If ' Case "F_09_122", "F_09_123", "F_09_20" ' Dim s As String = "" ' Dim s1 ' If vorlagendaten.Rows(i).Item("Briefanrede1") <> "" Then ' s = vorlagendaten.Rows(i).Item("Briefanrede1") ' If Microsoft.VisualBasic.Left(s, 4) = "Herr" Then ' s = "r " + s ' Else ' s = " " + s ' End If ' End If ' If vorlagendaten.Rows(i).Item("Briefanrede2") <> "" Then ' If s <> "" Then s = s + vbCrLf ' s1 = vorlagendaten.Rows(i).Item("Briefanrede2") ' If Microsoft.VisualBasic.Left(s1, 4) = "Herr" Then ' s = s + "Sehr geehrter " + s1 ' Else ' s = s + "Sehr geehrte " + s1 ' End If ' End If ' If s <> "" Then ' vorlagendaten.Rows(i).Item(i1) = s ' End If ' Case "F_09_98" ' If vorlagendaten.Rows(i).Item("Strasse") <> "" Then ' vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Strasse") ' End If ' Case "F_09_93" ' If vorlagendaten.Rows(i).Item("Ort") <> "" Then ' vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Ort") ' End If ' Case "F_09_93" ' If vorlagendaten.Rows(i).Item("Ort") <> "" Then ' vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Ort") ' End If ' Case "F_09_96" ' If vorlagendaten.Rows(i).Item("PLZ") <> "" Then ' vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("PLZ") ' End If ' Case "F_09_132" ' If vorlagendaten.Rows(i).Item("PLZ") <> "" Or vorlagendaten.Rows(i).Item("Ort") <> 0 Then ' vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("PLZ") + " " + vorlagendaten.Rows(i).Item("Ort") ' End If ' Case Else ' End Select ' 'Verknüpfte Felder ' Try ' Dim i2 As Integer ' For i2 = 0 To dsempfaenger.Tables("VerkFelder").Rows.Count - 1 ' If feldnr = dsempfaenger.Tables("verkfelder").Rows(i2).Item("Vorlagenfeldnr").ToString Then ' vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item(dsempfaenger.Tables("verkfelder").Rows(i2).Item("IDVWert")) ' End If ' Next ' Catch ' End Try ' If vorlagendaten.Rows(i).Item(i1) Is System.DBNull.Value Then ' vorlagendaten.Rows(i).Item(i1) = "" ' End If ' If Microsoft.VisualBasic.Left(vorlagendaten.Columns(i1).ColumnName, 5) = "F_09_" Then ' Insert_Value(vorlagendaten.Rows(i).Item(i1), vorlagendaten.Columns(i1).ColumnName) ' End If ' If Microsoft.VisualBasic.Left(vorlagendaten.Columns(i1).ColumnName, 5) = "I_09_" Then ' Dim intfeldname As String ' Dim Intbookmark As String ' Dim IntWert As String ' intfeldname = vorlagendaten.Columns(i1).ColumnName ' Intbookmark = Microsoft.VisualBasic.Right(vorlagendaten.Columns(i1).ColumnName, Len(vorlagendaten.Columns(i1).ColumnName) - 5) ' IntWert = Microsoft.VisualBasic.Right(vorlagendaten.Columns(i1).ColumnName, Len(vorlagendaten.Columns(i1).ColumnName) - 14) ' Dim SplitArray() As String ' Dim ind As Integer ' ind = IntWert.IndexOf("_09_") ' IntWert = Microsoft.VisualBasic.Left(IntWert, ind) ' 'SplitArray = IntWert.Split("_09_") ' 'IntWert = SplitArray(0) ' 'IntWert = RenCol(IntWert) ' Insert_Value(vorlagendaten.Rows(i).Item(IntWert), Intbookmark) ' End If ' Next ' If doktyp.bZu_retournieren.Value = True Or vorlagendaten.Rows(i).Item("blkunde") = 1 Or vorlagendaten.Rows(i).Item("Dokumentidbdr") <> "" Then ' blkunde = vorlagendaten.Rows(i).Item("blkunde") ' If vorlagendaten.Rows(i).Item("Dokumentidbdr") <> "" Then ' dokid = vorlagendaten.Rows(i).Item("Dokumentidbdr") ' Else ' dokid = vorlagendaten.Rows(i).Item("Dokumentid") ' End If ' Generate_Barcodes() ' blkunde = "" ' End If ' Dim dm As String ' dm = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + serienbriefnr.ToString + "_vorlage_" + i.ToString + ".doc" ' objword.ActiveDocument.SaveAs(dm) ' GenerierteDokumente.Add(dm) ' objword.Documents.Close(SAVECHANGES:=False) ' Catch ex As Exception ' MsgBox(ex.Message) ' vorlagendaten.Rows(i).Item("Status") = -1 ' End Try ' Next 'End Function Private Sub Dokumente_Generieren() Try If Params.PrinterDriver <> "" Then objword.ActivePrinter = Params.PrinterDriver End If Catch End Try Dim eintragnr As Integer If vorlagendaten.Rows.Count = 0 Then Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Main:Dokumente_Generieren: " + serienbriefnr.ToString + ":vorlagendaten.Rows.Count = 0 + EXIT FUNCTION:", Globals.Enum_BMS_Typen.Information) Exit Sub End If Try Dim Kopfzeile As Boolean serienbrief.cpMainConnectionProvider = Globals.conn_edoka serienbrief.iSerienbriefnr = New SqlInt32(CType(serienbriefnr, Int32)) serienbrief.SelectOne() doktyp.cpMainConnectionProvider = Globals.conn_edoka doktyp.iDokumenttypnr = serienbrief.iDokumenttypnr doktyp.SelectOne() officevorlage.cpMainConnectionProvider = Globals.conn_edoka officevorlage.iOffice_vorlagenr = doktyp.iOffice_vorlagenr officevorlage.SelectOne() If officevorlage.bKopfzeile_generieren.Value = True Then Kopfzeile = True Else Kopfzeile = False End If serienbrief.Dispose() doktyp.Dispose() officevorlage.Dispose() If Params.Log = "True" Then writelogfile("Windowstate:") Threading.Thread.Sleep(Globals.Params.Wordwait) objword.WindowState = Word.WdWindowState.wdWindowStateMinimize objword.Visible = True objword.WindowState = Word.WdWindowState.wdWindowStateNormal ' objword.Visible = False Dim i As Integer Dim i1 As Integer Dim feldnr As String Dim iwordcount As Integer = 0 For i = 0 To vorlagendaten.Rows.Count - 1 eintragnr = vorlagendaten.Rows(i).Item("IntEintragnr") Try 'Rel. 4.1 Word nach 100 Prints initialisieren 'iwordcount = iwordcount + 1 'If iwordcount > 100 Then ' iwordcount = 0 ' objword.ActiveDocument.Close(SaveChanges:=False) ' objword.Quit(SaveChanges:=False) ' objword = Nothing ' objword = New Word.Application ' If Params.PrinterDriver <> "" Then ' objword.ActivePrinter = Params.PrinterDriver ' End If 'End If If Params.Log = "True" Then writelogfile("Laden Word-Vorlage:" + Globals.Params.Pfad_Serienbrief_Daten + serienbriefnr.ToString + "_vorlage" + FileExtension) objword.Documents.Open(Globals.Params.Pfad_Serienbrief_Daten + serienbriefnr.ToString + "_vorlage" + FileExtension) 'Try ' If Params.PrinterDriver <> "" Then ' objword.ActivePrinter = Params.PrinterDriver ' End If 'Catch 'End Try objword.WindowState = Word.WdWindowState.wdWindowStateMinimize If Kopfzeile Then Insert_Kopfzeile() End If Dim sp1 As String Dim sp2() As String Dim ds As New DataSet ds.Tables.Add(vorlagendaten.Copy) If Params.Log = "True" Then writelogfile("Befüllen") For i1 = 0 To vorlagendaten.Columns.Count - 1 Try sp1 = vorlagendaten.Columns(i1).ColumnName sp2 = sp1.Split("_09_") sp1 = sp2(0) + "_09_" + sp2(2) feldnr = sp2(1).ToString sp1 = sp1 Catch sp1 = vorlagendaten.Columns(i1).ColumnName feldnr = sp1 End Try Select Case sp1 'Mapping Zustelladresse Case "F_09_1", "F_09_10" If vorlagendaten.Rows(i).Item("Zustelladresse") <> "" Then vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Zustelladresse") End If Case "F_09_89" If vorlagendaten.Rows(i).Item("Name") <> "" Then vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Name") End If Case "F_09_111" If vorlagendaten.Rows(i).Item("Vorname") <> "" Then vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Vorname") End If Case "F_09_122", "F_09_123", "F_09_20" Dim s As String = "" Dim s1 As String If vorlagendaten.Rows(i).Item("Briefanrede1") <> "" Then s = vorlagendaten.Rows(i).Item("Briefanrede1") If Microsoft.VisualBasic.Left(s, 4) = "Herr" Then s = "r " + s Else s = " " + s End If End If If vorlagendaten.Rows(i).Item("Briefanrede2") <> "" Then If s <> "" Then s = s + vbCrLf s1 = vorlagendaten.Rows(i).Item("Briefanrede2") If Microsoft.VisualBasic.Left(s1, 4) = "Herr" Then s = s + "Sehr geehrter " + s1 Else s = s + "Sehr geehrte " + s1 End If End If If s <> "" Then vorlagendaten.Rows(i).Item(i1) = s End If Case "F_09_98" If vorlagendaten.Rows(i).Item("Strasse") <> "" Then vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Strasse") End If Case "F_09_93" If vorlagendaten.Rows(i).Item("Ort") <> "" Then vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Ort") End If Case "F_09_93" If vorlagendaten.Rows(i).Item("Ort") <> "" Then vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("Ort") End If Case "F_09_96" If vorlagendaten.Rows(i).Item("PLZ") <> "" Then vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("PLZ") End If Case "F_09_132" If vorlagendaten.Rows(i).Item("PLZ") <> "" Or vorlagendaten.Rows(i).Item("Ort") <> 0 Then vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item("PLZ") + " " + vorlagendaten.Rows(i).Item("Ort") End If Case Else End Select 'Verknüpfte Felder Try Dim i2 As Integer For i2 = 0 To dsempfaenger.Tables("VerkFelder").Rows.Count - 1 If feldnr = dsempfaenger.Tables("verkfelder").Rows(i2).Item("Vorlagenfeldnr").ToString Then vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item(dsempfaenger.Tables("verkfelder").Rows(i2).Item("IDVWert")) End If Next Catch End Try If vorlagendaten.Rows(i).Item(i1) Is System.DBNull.Value Then vorlagendaten.Rows(i).Item(i1) = "" End If If Microsoft.VisualBasic.Left(vorlagendaten.Columns(i1).ColumnName, 5) = "F_09_" Then Insert_Value(vorlagendaten.Rows(i).Item(i1), vorlagendaten.Columns(i1).ColumnName) End If If Microsoft.VisualBasic.Left(vorlagendaten.Columns(i1).ColumnName, 5) = "I_09_" Then Dim intfeldname As String Dim Intbookmark As String Dim IntWert As String intfeldname = vorlagendaten.Columns(i1).ColumnName Intbookmark = Microsoft.VisualBasic.Right(vorlagendaten.Columns(i1).ColumnName, Len(vorlagendaten.Columns(i1).ColumnName) - 5) IntWert = Microsoft.VisualBasic.Right(vorlagendaten.Columns(i1).ColumnName, Len(vorlagendaten.Columns(i1).ColumnName) - 14) Dim ind As Integer ind = IntWert.IndexOf("_09_") IntWert = Microsoft.VisualBasic.Left(IntWert, ind) 'SplitArray = IntWert.Split("_09_") 'IntWert = SplitArray(0) 'IntWert = RenCol(IntWert) Insert_Value(vorlagendaten.Rows(i).Item(IntWert), Intbookmark) End If Next If doktyp.bZu_retournieren.Value = True Or vorlagendaten.Rows(i).Item("blkunde") = 1 Or vorlagendaten.Rows(i).Item("Dokumentidbdr") <> "" Then blkunde = vorlagendaten.Rows(i).Item("blkunde") 'Rel. 4.1 - Barcode generieren, bei DokumentIDBDR If vorlagendaten.Rows(i).Item("Dokumentidbdr") <> "" Then dokid = vorlagendaten.Rows(i).Item("Dokumentidbdr") Generate_Barcodes() Else dokid = vorlagendaten.Rows(i).Item("Dokumentid") 'Rel. 4.1 - Barcode nur generieren, wenn im Serienbrief so bestimmt If serienbrief.iBldossier.Value.ToString = "1" Then Generate_Barcodes() Else '20131220 - Barcodes generieren, sofern das dokument zu retournieren ist Generate_Barcodes() End If End If 'Generate_Barcodes() blkunde = "" End If '20110301-Region Set_Region() Dim docword As New Office.Interop.Word.Document docword = objword.ActiveDocument Threading.Thread.Sleep(Globals.Params.Wordwait) 'For i3 As Integer = 1 To objword.ActiveDocument.Bookmarks.Count - 1 ' If UCase(objword.ActiveDocument.Bookmarks(i3).Name) = UCase(Params.PP_Bookmark) Then ' insert_PPZeile() ' End If 'Next If Params.Log = "True" Then writelogfile("o2010: PDF-Export") If Params.Office2010 = True Then Try docword.ExportAsFixedFormat(Params.Pfad_Pdf + vorlagendaten.Rows(i).Item("Dokumentid") + ".pdf", Word.WdExportFormat.wdExportFormatPDF, False, Word.WdExportOptimizeFor.wdExportOptimizeForPrint, Word.WdExportRange.wdExportAllDocument, 1, 1, Word.WdExportItem.wdExportDocumentContent, True, True, Word.WdExportCreateBookmarks.wdExportCreateWordBookmarks, True, True, False) docword.Saved = True 'Hutter Exemplare Dim i2 As Integer For i2 = 1 To objword.ActiveDocument.Bookmarks.Count - 1 If objword.ActiveDocument.Bookmarks(i2).Name = "Change_fuer_Kunde_fuer_Bank" Then Try objword.ActiveDocument.Bookmarks("TXT_Exemplar").Range.Text = "die Bank" Catch End Try Try objword.ActiveDocument.Bookmarks("TXT_Exemplar2").Range.Text = "die Bank" Catch End Try docword.ExportAsFixedFormat(Params.Pfad_Pdf + vorlagendaten.Rows(i).Item("Dokumentid") + "_2.pdf", Word.WdExportFormat.wdExportFormatPDF, False, Word.WdExportOptimizeFor.wdExportOptimizeForPrint, Word.WdExportRange.wdExportAllDocument, 1, 1, Word.WdExportItem.wdExportDocumentContent, True, True, Word.WdExportCreateBookmarks.wdExportCreateWordBookmarks, True, True, False) Dim document As New PdfDocument() Dim ifiles As String() Dim inputDocument As String = Params.Pfad_Pdf + vorlagendaten.Rows(i).Item("Dokumentid") + ".pdf" Dim loadedDocument As New PdfLoadedDocument(inputDocument) loadedDocument.EnableMemoryOptimization = True document.ImportPageRange(loadedDocument, 0, loadedDocument.Pages.Count - 1) Dim inputDocument1 As String = Params.Pfad_Pdf + vorlagendaten.Rows(i).Item("Dokumentid") + "_2.pdf" Dim Loadeddocument1 As New PdfLoadedDocument(inputDocument1) Loadeddocument1.EnableMemoryOptimization = True document.ImportPageRange(Loadeddocument1, 0, Loadeddocument1.Pages.Count - 1) System.IO.File.Delete(Params.Pfad_Pdf + vorlagendaten.Rows(i).Item("Dokumentid") + "_2.pdf") System.IO.File.Delete(Params.Pfad_Pdf + vorlagendaten.Rows(i).Item("Dokumentid") + ".pdf") document.Save(Params.Pfad_Pdf + vorlagendaten.Rows(i).Item("Dokumentid") + ".pdf") document.Close(True) Exit For End If Next docword.Close(SaveChanges:=False) docword = Nothing Catch ex As Exception Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Export PDF: " + ex.Message + ":" + vorlagendaten.Rows(i).Item("Dokumentid").ToString, Globals.Enum_BMS_Typen.Information) End Try Else docword.PrintOut(OutputFileName:=Globals.Params.Pfad_PS + vorlagendaten.Rows(i).Item("Dokumentid") + ".ps", PrintToFile:=False, Copies:=1) PrintDokName = vorlagendaten.Rows(i).Item("Dokumentid") + ".pdf" Threading.Thread.Sleep(Globals.Params.Wordwait) docword.Close(SaveChanges:=False) docword = Nothing 'objword.ActiveDocument.PrintOut(outputfilename:=Globals.Params.Pfad_PS + vorlagendaten.Rows(i).Item("Dokumentid") + ".ps", printtofile:=False, Copies:=1) 'objword.Documents.Close(savechanges:=False) End If vorlagendaten.Rows(i).Item("Status") = 1 Dim dr As DataRow() Dim dr1 As DataRow dr = dsempfaenger.Tables(0).Select("IntEintragnr='" + vorlagendaten.Rows(i).Item("IntEintragNr") + "'") For Each dr1 In dr dr1.Item("Dokumentid") = vorlagendaten.Rows(i).Item("Dokumentid") dr1.Item("DokumentidBDR") = vorlagendaten.Rows(i).Item("DokumentidBDR") dr1.Item("Ersteller") = serienbrief.iVerantwortlich.Value dr1.Item("Status") = vorlagendaten.Rows(i).Item("Status") dr1.Item("BLKUNDE") = vorlagendaten.Rows(i).Item("BLKUNDE") Next If vorlagendaten.Rows(i).Item("blkunde") = 1 Then GenerierteBLDokumente.Add(New DruckJobData(vorlagendaten.Rows(i).Item("Dokumentid"), "", vorlagendaten.Rows(i).Item("IntEintragNr"), serienbrief.iVerantwortlich.Value, vorlagendaten.Rows(i).Item("BLKUNDE"), vorlagendaten.Rows(i).Item("dokumentidbdr"))) 'GenerierteBLDokumente.Add(vorlagendaten.Rows(i).Item("Dokumentid")) Else GenerierteDokumente.Add(New DruckJobData(vorlagendaten.Rows(i).Item("Dokumentid"), "", vorlagendaten.Rows(i).Item("IntEintragNr"), serienbrief.iVerantwortlich.Value, vorlagendaten.Rows(i).Item("BLKUNDE"), vorlagendaten.Rows(i).Item("dokumentidbdr"))) 'GenerierteDokumente.Add(vorlagendaten.Rows(i).Item("Dokumentid")) End If Catch ex As Exception If Params.Log = "True" Then writelogfile("Wordhandling: " + ex.Message) vorlagendaten.Rows(i).Item("Status") = -1 End Try Next Catch ex As Exception If Params.Log = "True" Then writelogfile("Fehler:" + ex.Message) Dim dr As DataRow() Dim dr1 As DataRow Try dr = dsempfaenger.Tables(0).Select("IntEintragnr='" + eintragnr + "'") For Each dr1 In dr dr1.Item("Status") = -1 Next Catch End Try Finally serienbrief.cpMainConnectionProvider = Globals.conn_edoka serienbrief.iSerienbriefnr = New SqlInt32(CType(serienbriefnr, Int32)) serienbrief.SelectOne() serienbrief.iStatus = New SqlInt32(CType(0, Int32)) Globals.conn_edoka.OpenConnection() serienbrief.Update() Globals.conn_edoka.CloseConnection(True) End Try End Sub Public Sub writelogfile(ByVal s As String) FileOpen(1, Params.LogPfad, OpenMode.Append) WriteLine(1, Now.ToString, s) FileClose(1) End Sub Public Sub insert_PPZeile(bm As String, ByVal Typ As String) Try If Typ = "B" Then objword.ActiveDocument.Bookmarks(bm).Range.InlineShapes.AddPicture(Params.PPFileB, LinkToFile:=False, SaveWithDocument:=True).Select() Else objword.ActiveDocument.Bookmarks(bm).Range.InlineShapes.AddPicture(Params.PPFileA, LinkToFile:=False, SaveWithDocument:=True).Select() End If Catch End Try ' objword.ActiveDocument.InlineShapes.AddPicture(Params.PPFile, LinkToFile:=False, SaveWithDocument:=True).Select() 'objword.Selection.ShapeRange.WrapFormat.Type = Word.WdWrapType.wdWrapFront 'objword.Selection.ShapeRange.Left = Params.PPLeft 'objword.Selection.ShapeRange.Top = Params.PPTop End Sub Private Sub Insert_Value(ByVal feldwert As String, ByVal feldname As String) Dim dc As DataRow Dim pos1 As Integer Dim pos2 As Integer 'Test If feldwert = "**PPZeileB" Then 'MsgBox(beginntextmarke) For Each dc In dsempfaenger.Tables("UsedFelder").Rows If dc.Item("TempFeldName") = feldname Then beginntextmarke = dc.Item("Beginntextmarke") endetextmarke = dc.Item("Endetextmarke") feldname = dc.Item("Feldname") insert_PPZeile(beginntextmarke, "B") Exit Sub End If Next End If If feldwert = "**PPZeileA" Then 'MsgBox(beginntextmarke) For Each dc In dsempfaenger.Tables("UsedFelder").Rows If dc.Item("TempFeldName") = feldname Then beginntextmarke = dc.Item("Beginntextmarke") endetextmarke = dc.Item("Endetextmarke") feldname = dc.Item("Feldname") insert_PPZeile(beginntextmarke, "A") Exit Sub End If Next End If If Left(feldname, 5) = "TMISB" Then beginntextmarke = feldname endetextmarke = "" feldname = "" Else For Each dc In dsempfaenger.Tables("UsedFelder").Rows If dc.Item("TempFeldName") = feldname Then beginntextmarke = dc.Item("Beginntextmarke") endetextmarke = dc.Item("Endetextmarke") feldname = dc.Item("Feldname") Exit For End If Next End If 'contentcontrols Try If feldname.Length > 2 Then If feldname <> "" And feldname.Substring(0, 3) = "cc_" Then objword.ActiveDocument.SelectContentControlsByTag(feldname).Item(1).Range.Text = feldwert End If End If Catch ex As Exception End Try If beginntextmarke <> "" And endetextmarke = "" Then Try objword.ActiveDocument.Bookmarks.Item(beginntextmarke).Select() objword.Selection.Text = feldwert Catch ex As Exception End Try End If If beginntextmarke <> "" And endetextmarke <> "" Then Try pos1 = objword.ActiveDocument.Bookmarks.Item(beginntextmarke).Start pos2 = objword.ActiveDocument.Bookmarks.Item(endetextmarke).Start objword.Selection.SetRange(Start:=pos1, End:=pos2) objword.Selection.TypeText(Text:=feldwert) Catch ex As Exception End Try End If End Sub Private Function Vorlage_Auslesen(ByVal serienbriefnr As Integer) As Boolean Try FileExtension = "" Dim dokumentname As String = Globals.Params.Pfad_Serienbrief_Daten + serienbriefnr.ToString + "_vorlage.doc" Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from edex_sb_vorlage where serienbriefnr=" + Str(serienbriefnr), Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Try Connection.ConnectionString = Globals.sConnectionString_edoka Connection.Open() DA.Fill(ds, "empf") Dim myRow As DataRow If ds.Tables(0).Rows.Count = 0 Then Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Vorlage kann nicht geladen werden: " + serienbriefnr.ToString, Globals.Enum_BMS_Typen.Warnung) Else myRow = ds.Tables(0).Rows(0) Dim MyData() As Byte MyData = myRow.Item(1) FileExtension = myRow.Item(2).ToString If UCase(FileExtension) = "NULL" Or FileExtension = "" Then FileExtension = ".doc" Dim K As Long K = UBound(MyData) dokumentname = Globals.Params.Pfad_Serienbrief_Daten + serienbriefnr.ToString + "_Vorlage" + FileExtension Dim fs As New FileStream(dokumentname, FileMode.OpenOrCreate, FileAccess.Write) fs.Write(MyData, 0, K) fs.Close() fs = Nothing End If Catch ex As Exception Return False End Try cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing Return True Catch EX As Exception Return False End Try End Function #End Region #Region "WordCommands" Private Sub insert_Barcode(ByVal x As Integer) Dim Form As Word.Shape Dim s As String Try 'Form = objword.ActiveDocument.Sections(1).Footers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Shapes.Item(Textboxes(Textboxesi)) Form = objword.Selection.HeaderFooter.Shapes.Item(Textboxes(Textboxesi)) Form.Select() Form = objword.Selection.HeaderFooter.Shapes.Item(Textboxes(Textboxesi)) Form.Select() If officevorlage.bBchorizontal.Value = False Then objword.ActiveDocument.Tables.Add(Range:=objword.Selection.Range, NumRows:=1, NumColumns:=1) With objword.Selection.Tables.Item(1) 'MsgBox("Test") .Borders.Item(Word.WdBorderType.wdBorderLeft).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderRight).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderTop).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderBottom).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderDiagonalDown).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderDiagonalUp).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Shadow = False End With objword.Selection.Orientation = Word.WdTextOrientation.wdTextOrientationUpward objword.Selection.Tables.Item(1).Rows.HeightRule = Word.WdRowHeightRule.wdRowHeightAtLeast objword.Selection.Tables.Item(1).Rows.Height = Form.Height End If Dim id As String id = dokid s = Bar25I(Microsoft.VisualBasic.Right(Right(id, Len(id) - 6), 16)) objword.Selection.Font.Name = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("barcode_font") objword.Selection.Font.Size = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("bcfont_groesse") objword.Selection.TypeText(Text:=s) objword.Selection.HomeKey(Unit:=Word.WdUnits.wdLine, Extend:=Word.WdMovementType.wdExtend) objword.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphRight objword.Selection.EndKey(Unit:=Word.WdUnits.wdLine) objword.Selection.Font.Name = "Arial" objword.Selection.Font.Size = 8 Dim Zeichen As String If doktyp.bZu_retournieren.Value = True Then Try Dim dokt As New edokadb.clsDokumenttyp() dokt.cpMainConnectionProvider = Globals.conn_edoka dokt.iDokumenttypnr = New SqlInt32(CType(doktyp.iDoktypbedingteretournierung.Value, Int32)) dokt.SelectOne() If dokt.iPhysisches_archiv.Value = 2 Then 'EDEX Banklagernd Zeichen = " F" 'objWord.Selection.TypeText(" F") Else Zeichen = " U" 'objWord.Selection.TypeText(" U") End If dokt.Dispose() Catch ex As Exception If doktyp.iPhysisches_archiv.Value = 2 Then Zeichen = " F" Else Zeichen = " U" End If End Try Else If doktyp.iPhysisches_archiv.Value = 2 Then Zeichen = " F" ' objWord.Selection.TypeText(" F") Else Zeichen = " U" 'objWord.Selection.TypeText(" U") End If End If Try '20131220 If serienbrief.iBldossier.Value.ToString = "1" Then If Val(blkunde) = 1 Then Zeichen = Zeichen + "/B" End If End If Catch '20131220 If serienbrief.iBldossier.Value.ToString = "1" Then If blkunde = "1" Then Zeichen = Zeichen + "/B" End If End If End Try objword.Selection.TypeText(Zeichen) Form = Nothing Catch ex As Exception ' MsgBox(ex.Message) End Try End Sub Private Sub ins_Barcode() Dim xname As Object Dim i As Integer Dim pages As Long pages = objword.ActiveDocument.BuiltInDocumentProperties("NUMBER OF PAGES").value objword.Selection.HomeKey(Unit:=Word.WdUnits.wdStory) Textboxesi = 1 For i = 1 To pages xname = Str(i) If Left(xname, 1) = " " Then xname = Right(xname, Len(xname) - 1) objword.Selection.GoTo(What:=Word.WdGoToItem.wdGoToPage, Name:=xname) HeaderFooterAnzeigen() insert_Barcode(i) Textboxesi = Textboxesi + 1 objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekMainDocument Next i End Sub Private Sub HeaderFooterAnzeigen() If objword.ActiveWindow.View.SplitSpecial <> Word.WdSpecialPane.wdPaneNone Then objword.ActiveWindow.Panes.Item(2).Close() End If If objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdNormalView Or objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdOutlineView Then objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdPrintView End If objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekCurrentPageHeader If objword.Selection.HeaderFooter.IsHeader = True Then objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekCurrentPageFooter Else objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekCurrentPageHeader End If End Sub Dim Textboxes(100) As String Dim Textboxesi As Integer Private Sub insert_Textfield() Dim Public_barcodeleft As Integer Dim Public_barcodetop As Integer Dim Public_barcodewidth# Dim Public_barcodeheight As Integer Try Public_barcodeleft = 260 Public_barcodetop = 794 Public_barcodewidth = 300 Public_barcodeheight = 33 Public_barcodeleft = officevorlage.iBcpl.Value Public_barcodetop = officevorlage.iBcpt.Value Public_barcodewidth = officevorlage.iBcw.Value Public_barcodeheight = officevorlage.iBch.Value HeaderFooterAnzeigen() Dim i As Integer objword.Selection.HeaderFooter.Shapes.AddTextbox(1, Public_barcodeleft, Public_barcodetop, Public_barcodewidth#, Public_barcodeheight).Select() ' objWord.Selection.ShapeRange.TextFrame.TextRange.Select 'hutter pendenz 'objword.Selection.ShapeRange.Line.Visible = Office.Core.MsoTriState.msoFalse objword.Selection.ShapeRange.Line.Visible = Office.Core.MsoTriState.msoFalse objword.Selection.ShapeRange.TextFrame.MarginLeft = 0.0# objword.Selection.ShapeRange.TextFrame.MarginRight = 0.0# objword.Selection.ShapeRange.TextFrame.MarginTop = 0.0# objword.Selection.ShapeRange.TextFrame.MarginBottom = 0.0# objword.Selection.Collapse() Textboxes(Textboxesi) = objword.Selection.HeaderFooter.Shapes.Item(Textboxesi).Name Textboxesi = Textboxesi + 1 Exit Sub Catch ex As Exception 'MsgBox(ex.Message) Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Main:insert_Textfield:SB " + serienbriefnr.ToString + ":" + ex.Message + ex.StackTrace, Globals.Enum_BMS_Typen.Warnung) End Try End Sub Private Sub Generate_Barcodes() ' Test1() Insert_TextFelder() ins_Barcode() End Sub Public Sub Test1() Dim i As Integer Dim Form As Word.Shape Dim Public_barcodeleft As Integer Dim Public_barcodetop As Integer Dim Public_barcodewidth# Dim Public_barcodeheight As Integer Try Public_barcodeleft = 260 Public_barcodetop = 794 Public_barcodewidth = 300 Public_barcodeheight = 33 Public_barcodeleft = officevorlage.iBcpl.Value Public_barcodetop = officevorlage.iBcpt.Value Public_barcodewidth = officevorlage.iBcw.Value Public_barcodeheight = officevorlage.iBch.Value For i = 1 To objword.ActiveDocument.Sections.Count Try objword.ActiveDocument.Sections(i).Footers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Shapes.AddTextbox(1, Public_barcodeleft, Public_barcodetop, Public_barcodewidth#, Public_barcodeheight).Select() Form = objword.ActiveDocument.Sections(i).Footers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Shapes(1) Form.Select() If officevorlage.bBchorizontal.Value = False Then objword.ActiveDocument.Tables.Add(Range:=objword.Selection.Range, NumRows:=1, NumColumns:=1) With objword.Selection.Tables.Item(1) 'MsgBox("Test") .Borders.Item(Word.WdBorderType.wdBorderLeft).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderRight).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderTop).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderBottom).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderDiagonalDown).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderDiagonalUp).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Shadow = False End With objword.Selection.Orientation = Word.WdTextOrientation.wdTextOrientationUpward objword.Selection.Tables.Item(1).Rows.HeightRule = Word.WdRowHeightRule.wdRowHeightAtLeast objword.Selection.Tables.Item(1).Rows.Height = Form.Height End If Dim id As String id = dokid Dim s As String s = Bar25I(Microsoft.VisualBasic.Right(Right(id, Len(id) - 6), 16)) objword.Selection.Font.Name = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("barcode_font") objword.Selection.Font.Size = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("bcfont_groesse") objword.Selection.TypeText(Text:=s) objword.Selection.HomeKey(Unit:=Word.WdUnits.wdLine, Extend:=Word.WdMovementType.wdExtend) objword.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphRight objword.Selection.EndKey(Unit:=Word.WdUnits.wdLine) objword.Selection.Font.Name = "Arial" objword.Selection.Font.Size = 8 Dim Zeichen As String If doktyp.bZu_retournieren.Value = True Then Try Dim dokt As New edokadb.clsDokumenttyp() dokt.cpMainConnectionProvider = Globals.conn_edoka dokt.iDokumenttypnr = New SqlInt32(CType(doktyp.iDoktypbedingteretournierung.Value, Int32)) dokt.SelectOne() If dokt.iPhysisches_archiv.Value = 2 Then 'EDEX Banklagernd Zeichen = " F" 'objWord.Selection.TypeText(" F") Else Zeichen = " U" 'objWord.Selection.TypeText(" U") End If dokt.Dispose() Catch ex As Exception If doktyp.iPhysisches_archiv.Value = 2 Then Zeichen = " F" Else Zeichen = " U" End If End Try Else If doktyp.iPhysisches_archiv.Value = 2 Then Zeichen = " F" ' objWord.Selection.TypeText(" F") Else Zeichen = " U" 'objWord.Selection.TypeText(" U") End If End If Try '20131220 If serienbrief.iBldossier.Value.ToString = "1" Then If Val(blkunde) = 1 Then Zeichen = Zeichen + "/B" End If End If Catch '20131220 If serienbrief.iBldossier.Value.ToString = "1" Then If blkunde = "1" Then Zeichen = Zeichen + "/B" End If End If End Try objword.Selection.TypeText(Zeichen) Form = Nothing Catch End Try Next Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub Insert_TextFelder() Dim xname As Object Dim i As Integer Dim pages As Long pages = objword.ActiveDocument.BuiltInDocumentProperties("NUMBER OF PAGES").value Textboxesi = 1 objword.Selection.HomeKey(Unit:=Word.WdUnits.wdStory) For i = 1 To pages xname = Str(i) If Left(xname, 1) = " " Then xname = Right(xname, Len(xname) - 1) objword.Selection.GoTo(What:=Word.WdGoToItem.wdGoToPage, Name:=xname) insert_Textfield() objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekMainDocument Next i End Sub Private Sub Insert_Kopfzeile() objword.Selection.HomeKey(Unit:=Word.WdUnits.wdStory) If objword.ActiveWindow.View.SplitSpecial <> Word.WdSpecialPane.wdPaneNone Then objword.ActiveWindow.Panes.Item(2).Close() End If If objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdNormalView Or objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdOutlineView Then objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdPrintView End If objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekCurrentPageHeader set_headerbookmark() objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekMainDocument End Sub Private Sub set_headerbookmark() Try objword.ActiveDocument.Bookmarks.Item("TGEDKCompanyBBEB99").Select() Catch objword.Selection.MoveDown(Unit:=Word.WdUnits.wdLine, Count:=1) With objword.ActiveDocument.Bookmarks .Add(Range:=objword.Selection.Range, Name:="TGEDKCompanyBBEB99") .DefaultSorting = Word.WdBookmarkSortBy.wdSortByName .ShowHidden = False End With End Try End Sub #End Region #Region "PrintJob" Dim gendok As DruckJobData Dim workdir As String = Globals.Params.Pfad_Serienbrief_Daten + serienbriefnr.ToString + "\" Dim druckjobdir As String = workdir + "Druckjob\" Dim druckjobnr As Integer Dim first As Boolean Private Sub Create_Printjob() Dim dr As DataRow() Dim dr1 As DataRow = Nothing AnzahlPrintJobs = 0 workdir = Globals.Params.Pfad_Serienbrief_Daten + serienbriefnr.ToString + "\" druckjobdir = workdir + "Druckjob\" 'Check TempDir If Not IO.Directory.Exists(workdir) Then IO.Directory.CreateDirectory(workdir) End If If Not IO.Directory.Exists(druckjobdir) Then IO.Directory.CreateDirectory(druckjobdir) End If Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Druckjob : " + serienbriefnr.ToString + ": Anz. Dokumente: " + GenerierteDokumente.Count.ToString, Globals.Enum_BMS_Typen.Information) Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Druckjob : " + serienbriefnr.ToString + ": Anz. BL-Dokumente: " + GenerierteBLDokumente.Count.ToString, Globals.Enum_BMS_Typen.Information) MailText = MailText + " Dok: " + GenerierteDokumente.Count.ToString + " / BL: " + GenerierteBLDokumente.Count.ToString If GenerierteDokumente.Count = 0 And GenerierteBLDokumente.Count = 0 Then Exit Sub 'Rel. 4.1 Prüfung, ob der letzte Filename gedruckt wurde Dim akttime As DateTime = Now akttime = DateAdd(DateInterval.Minute, Params.MaxWait, akttime) Dim dokfound As Boolean = False If Params.Office2010 <> True Then While Now < akttime And dokfound = False If IO.File.Exists(Globals.Params.Pfad_Pdf + PrintDokName) Then dokfound = True Threading.Thread.Sleep(100) End While End If 'Wait aufgrund der Anzahl Dokumente berechnen ' Dim TotalAnzahl As Integer ' TotalAnzahl = GenerierteDokumente.Count + GenerierteBLDokumente.Count ' If TotalAnzahl > 100 Then ' TotalAnzahl = (TotalAnzahl / 50) + 2 ' Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: Druckjob warten auf PDF: " + TotalAnzahl.ToString + " Minuten", Globals.Enum_BMS_Typen.Information) ' Else ' TotalAnzahl = (TotalAnzahl / 50) + 1 ' End If ' Threading.Thread.Sleep(TotalAnzahl * 60000) 'Ende Rel. 4.1 'System.Threading.Thread.CurrentThread.Sleep(60000) Dim i As Integer '20161011 - Sortierung anpassen For i = 1 To GenerierteDokumente.Count 'For i = GenerierteDokumente.Count To 1 Step -1 gendok = GenerierteDokumente(i) dr = dsempfaenger.Tables(0).Select("IntEintragnr='" + gendok.eintragnr.ToString + "'") 'FileOpen(1, "k:\tmpgendoc.txt", OpenMode.Append) Dim s As String For Each dr1 In dr s = dr1.Item("Partnernr") Next 'WriteLine(1, gendok.eintragnr & Chr(9) & gendok.dokumentid & Chr(9) & s) 'FileClose(1) Next druckjobnr = GenerierteDokumente.Count / Globals.Params.Anzahl_Dokumente_Druckjob + 1 druckjobnr = druckjobnr - 1 druckjobid = druckjobnr.ToString + "_" + Format(Now, "yyyyMMddHHmmss") druckjobname = druckjobdir + "DF_" + druckjobnr.ToString + "_" + Format(Now, "yyyyMMddHHmmss") + ".pdf" ReDim files(Globals.Params.Anzahl_Dokumente_Druckjob) PrintCounter = 0 first = True '20161011 For i = 1 To GenerierteDokumente.Count 'For i = GenerierteDokumente.Count To 1 Step -1 gendok = GenerierteDokumente(i) Dim sourcefile As String sourcefile = Globals.Params.Pfad_Pdf + gendok.dokumentid + ".pdf" Dim psfile As String psfile = Globals.Params.Pfad_Pdf + gendok.dokumentid + ".ps" Dim logfile As String logfile = Globals.Params.Pfad_Pdf + gendok.dokumentid + ".log" Dim targetfile As String targetfile = workdir + gendok.dokumentid + ".pdf" If IO.File.Exists(sourcefile) Then IO.File.Move(sourcefile, targetfile) Try IO.File.Delete(psfile) Catch End Try Try IO.File.Delete(logfile) Catch End Try addfile_to_printjob(targetfile) dr = dsempfaenger.Tables(0).Select("IntEintragnr='" + gendok.eintragnr.ToString + "'") For Each dr1 In dr dr1.Item("Dokumentid") = gendok.dokumentid dr1.Item("DokumentidBDR") = gendok.Dokumentidbdr dr1.Item("Ersteller") = gendok.ersteller dr1.Item("Status") = 2 dr1.Item("BLKUNDE") = gendok.blkunde dr1.Item("DRUCKJOBID") = druckjobid Next Else dr = dsempfaenger.Tables(0).Select("IntEintragnr='" + gendok.eintragnr.ToString + "'") dr1.Item("Dokumentid") = gendok.dokumentid dr1.Item("DokumentidBDR") = gendok.Dokumentidbdr dr1.Item("Ersteller") = gendok.ersteller dr1.Item("Status") = -1 dr1.Item("Fehlercode") = 4 dr1.Item("BLKUNDE") = gendok.blkunde dr1.Item("DRUCKJOBID") = "" End If Next If PrintCounter > 0 Then Save_Printjob(druckjobname) End If Threading.Thread.Sleep(1000) 'bl-dokumente AnzahlPrintJobs = 0 druckjobnr = GenerierteBLDokumente.Count / Globals.Params.Anzahl_Dokumente_Druckjob + 1 druckjobnr = druckjobnr - 1 druckjobid = druckjobnr.ToString + "_" + Format(Now, "yyyyMMddHHmmss") druckjobname = druckjobdir + "DF_" + druckjobnr.ToString + "_" + Format(Now, "yyyyMMddHHmmss") + ".pdf" ReDim files(Globals.Params.Anzahl_Dokumente_Druckjob) PrintCounter = 0 first = True '20161011 - Sortierung For i = 1 To GenerierteBLDokumente.Count 'For i = GenerierteBLDokumente.Count To 1 Step -1 gendok = GenerierteBLDokumente(i) Dim sourcefile As String = Globals.Params.Pfad_Pdf + gendok.dokumentid + ".pdf" Dim psfile As String = Globals.Params.Pfad_Pdf + gendok.dokumentid + ".ps" Dim logfile As String = Globals.Params.Pfad_Pdf + gendok.dokumentid + ".log" Dim targetfile As String = workdir + gendok.dokumentid + ".pdf" If IO.File.Exists(sourcefile) Then IO.File.Move(sourcefile, targetfile) Try IO.File.Delete(psfile) Catch End Try Try IO.File.Delete(logfile) Catch End Try addfile_to_printjob(targetfile) dr = dsempfaenger.Tables(0).Select("IntEintragnr='" + gendok.eintragnr.ToString + "'") For Each dr1 In dr dr1.Item("Dokumentid") = gendok.dokumentid dr1.Item("DokumentidBDR") = gendok.Dokumentidbdr dr1.Item("Ersteller") = gendok.ersteller dr1.Item("Status") = 2 dr1.Item("BLKUNDE") = gendok.blkunde dr1.Item("DRUCKJOBID") = druckjobid Next Else dr = dsempfaenger.Tables(0).Select("IntEintragnr='" + gendok.eintragnr.ToString + "'") dr1.Item("Dokumentid") = gendok.dokumentid dr1.Item("DokumentidBDR") = gendok.Dokumentidbdr dr1.Item("Ersteller") = gendok.ersteller dr1.Item("Status") = -1 dr1.Item("Fehlercode") = 4 dr1.Item("BLKUNDE") = gendok.blkunde dr1.Item("DRUCKJOBID") = "" End If Next If PrintCounter > 0 Then Save_Printjob(druckjobname) End If End Sub Dim druckjobid As String Dim Printjobopen As Boolean = False Dim PrintCounter As Integer Dim acrobatfileopen As Boolean = False Dim druckjobname As String Dim AnzahlPrintJobs As Integer = 0 Dim files As String() Private Sub addfile_to_printjob(ByVal filename As String) If PrintCounter >= Globals.Params.Anzahl_Dokumente_Druckjob Then Save_Printjob(druckjobname) druckjobnr = druckjobnr - 1 druckjobid = druckjobnr.ToString + "_" + Format(Now, "yyyyMMddHHmmss") druckjobname = druckjobdir + "DF_" + druckjobnr.ToString + "_" + Format(Now, "yyyyMMddHHmmss") + ".pdf" PrintCounter = 0 ReDim files(Globals.Params.Anzahl_Dokumente_Druckjob) AnzahlPrintJobs = AnzahlPrintJobs + 1 End If files(PrintCounter) = filename PrintCounter = PrintCounter + 1 End Sub Private Function Save_Printjob(ByVal Filename As String) As Boolean Dim ifiles As String() Dim cnt As Integer = -1 For Each dn As String In files If Not dn Is Nothing Then cnt = cnt + 1 Next ReDim ifiles(cnt) cnt = 0 For Each dn As String In files If Not dn Is Nothing Then ifiles(cnt) = dn cnt = cnt + 1 End If Next Dim document As New PdfDocument() document.EnableMemoryOptimization = True For Each inputDocument As String In ifiles Dim loadedDocument As New PdfLoadedDocument(inputDocument) loadedDocument.EnableMemoryOptimization = True document.ImportPageRange(loadedDocument, 0, loadedDocument.Pages.Count - 1) loadedDocument.Close(True) Next document.Save(druckjobname) document.Close() Try Dim dokumentname As String = Filename Dim Connection As New SqlConnection Dim DA As New SqlDataAdapter("select * from edex_sb_druckjob where serienbriefnr=" + Str(serienbriefnr), Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet Dim fs As New FileStream(dokumentname, FileMode.Open, FileAccess.Read) Dim mydata(fs.Length) As Byte Try fs.Read(mydata, 0, fs.Length) fs.Close() Connection.ConnectionString = Globals.sConnectionString_edoka Connection.Open() DA.Fill(ds, "sbprintjob") Dim myRow As DataRow 'If ds.Tables(0).Rows.Count = 0 Then 'Neue Serienbrief_Empfaenger speichern myRow = ds.Tables(0).NewRow myRow.Item(1) = serienbriefnr myRow.Item(2) = 0 myRow.Item(3) = Now myRow.Item(4) = Now myRow.Item(5) = 9999 myRow.Item(6) = mydata myRow.Item(7) = druckjobid myRow.Item(8) = 1 ds.Tables(0).Rows.Add(myRow) DA.Update(ds, "sbprintjob") 'Else ' ' Bestehende Empfängerliste überschreiben ' myRow = ds.Tables(0).Rows(0) ' myRow.Item(2) = mydata ' DA.Update(ds, "empf") 'End If Catch ex As Exception Return False End Try fs = Nothing cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing Return True Catch EX As Exception Return False End Try End Function #End Region #Region "Barcode-Berechnung" Private BarTextOut As String Private BarTextIn As String Private DoCheckSum As Integer Private TempString As String Private CharValue As Long Private II As Integer Private Sum As Long Private barcodeout As String Private CheckSum As Integer ' Copyright 2001 by Elfring Fonts Inc. All rights reserved. This code ' may not be modified or altered in any way. 'Functions in this file: ' Bar25I(Text) -> convert text to bar code 2/5 interleaved ' Bar25Ics(Text) -> convert text to bar code 2/5 interleaved with checksum '--------------------------------------------------------------------------- ' This function converts a string of digits into a format compatible with Elfring ' Fonts Inc bar codes. It adds the start character, scans and converts digit pairs ' into single ASCII characters, and adds a stop character. Note that non-digits are ' ignored, and if you enter an odd number of digits, a leading zero will be added. '--------------------------------------------------------------------------- Public Function Bar25I(ByVal BarTextIn As String) As String ' Initialize input and output strings BarTextOut = "" BarTextIn = RTrim(LTrim(BarTextIn)) ' Throw away non-numeric data TempString = "" For II = 1 To Len(BarTextIn) If IsNumeric(Mid(BarTextIn, II, 1)) Then TempString = TempString & Mid(BarTextIn, II, 1) End If Next II ' If not an even number of digits, add a leading 0 If (Len(TempString) Mod 2) = 1 Then TempString = "0" & TempString End If ' Break digit pairs up and convert to characters- build output string For II = 1 To Len(TempString) Step 2 'Break string into pairs of digits and get value CharValue = Mid(TempString, II, 2) 'translate value to ASCII and save in BarTextOut If CharValue < 90 Then BarTextOut = BarTextOut & Chr(CharValue + 33) Else BarTextOut = BarTextOut & Chr(CharValue + 71) End If Next II 'Build ouput string, trailing space for Windows rasterization bug barcodeout = "{" & BarTextOut & "} " 'Return the string Bar25I = barcodeout End Function '--------------------------------------------------------------------------- ' This function converts a string of digits into a format compatible with Elfring ' Fonts Inc bar codes. It adds the start character, scans and converts digit pairs ' into single ASCII characters, and adds checksum and a stop character. Note that ' non-digits are ignored, and if you enter an even number of digits, a leading zero ' will be added. '--------------------------------------------------------------------------- Public Function Bar25Ics(ByVal BarTextIn As String) As String ' Initialize input and output strings BarTextOut = "" BarTextIn = RTrim(LTrim(BarTextIn)) ' Throw away non-numeric data TempString = "" For II = 1 To Len(BarTextIn) If IsNumeric(Mid(BarTextIn, II, 1)) Then TempString = TempString & Mid(BarTextIn, II, 1) End If Next II ' If not an odd number of digits, add a leading 0 If (Len(TempString) Mod 2) = 0 Then TempString = "0" & TempString End If ' Figure out the checksum digit Sum = 0 For II = 1 To Len(TempString) CharValue = Mid(TempString, II, 1) If (II Mod 2) = 1 Then Sum = Sum + (3 * CharValue) Else Sum = Sum + CharValue End If Next II ' Figure checksum, add it as last digit CheckSum = 10 - (Sum Mod 10) If CheckSum = 10 Then CheckSum = 0 TempString = TempString & Chr(48 + CheckSum) ' Break digit pairs up and convert to characters- build output string For II = 1 To Len(TempString) Step 2 'Break string into pairs of digits and get value CharValue = Mid(TempString, II, 2) 'translate value to ASCII and save in BarTextOut If CharValue < 90 Then BarTextOut = BarTextOut & Chr(CharValue + 33) Else BarTextOut = BarTextOut & Chr(CharValue + 71) End If Next II 'Build ouput string, trailing space for Windows rasterization bug barcodeout = "{" & BarTextOut & "} " 'Return the string Bar25Ics = barcodeout End Function #End Region #Region "Druckjobdata" Public Class DruckJobData Dim m_dokumentid As String Property dokumentid() As String Get Return m_dokumentid End Get Set(ByVal Value As String) m_dokumentid = Value End Set End Property Dim m_dokumentidbdr As String Property Dokumentidbdr() As String Get Return m_dokumentidbdr End Get Set(ByVal Value As String) m_dokumentidbdr = Value End Set End Property Dim m_blkunde As Integer Property blkunde() As Integer Get Return m_blkunde End Get Set(ByVal Value As Integer) m_blkunde = Value End Set End Property Dim m_ersteller As Integer Property ersteller() As Integer Get Return m_ersteller End Get Set(ByVal Value As Integer) m_ersteller = Value End Set End Property Dim m_druckjobid As String Property Druckjobid() As String Get Return m_druckjobid End Get Set(ByVal Value As String) m_druckjobid = Value End Set End Property Dim m_eintragnr As Integer Property eintragnr() As Integer Get Return m_eintragnr End Get Set(ByVal Value As Integer) m_eintragnr = Value End Set End Property Public Sub New(ByVal Dokumentid As String, ByVal Druckjobid As String, ByVal Eintragnr As Integer, _ ByVal ersteller As Integer, ByVal blkunde As Integer, ByVal dokumentidbdr As String) m_dokumentid = Dokumentid m_druckjobid = Druckjobid m_eintragnr = Eintragnr m_ersteller = ersteller m_blkunde = blkunde m_dokumentidbdr = dokumentidbdr End Sub End Class #End Region #Region "Regionenbezeichnunung" Private Sub Set_Region() 'For Each ws As Word.Shape In objWord.ActiveDocument.Shapes ' If ws.Name = "RegionenTextFeld" Then ws.Delete() 'Next Dim Public_barcodeleft Dim Public_barcodetop Dim Public_barcodewidth# Dim Public_barcodeheight Try Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandText = "dbo.sp_get_regionentextfeld" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = Globals.conn_edoka.scoDBConnection scmCmdToExecute.Connection.Open() Try scmCmdToExecute.Parameters.Clear() scmCmdToExecute.Parameters.Add(New SqlParameter("@Office_Vorlagennr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, officevorlage.iOffice_vorlagenr.Value)) scmCmdToExecute.Parameters.Add(New SqlParameter("@Teamnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, serienbrief.iTeam.Value)) scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, "")) scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttypnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, serienbrief.iDokumenttypnr.Value)) scmCmdToExecute.Parameters.Add(New SqlParameter("@PrintIt", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.Parameters.Add(New SqlParameter("@Left", SqlDbType.Float, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.Parameters.Add(New SqlParameter("@Top", SqlDbType.Float, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.Parameters.Add(New SqlParameter("@Width", SqlDbType.Float, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.Parameters.Add(New SqlParameter("@Height", SqlDbType.Float, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.Parameters.Add(New SqlParameter("@Inhalt", SqlDbType.VarChar, 255, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, "")) scmCmdToExecute.Parameters.Add(New SqlParameter("@Font", SqlDbType.VarChar, 255, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, "")) scmCmdToExecute.Parameters.Add(New SqlParameter("@FontSize", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.Parameters.Add(New SqlParameter("@Page", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.Parameters.Add(New SqlParameter("@Spacing", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.Parameters.Add(New SqlParameter("@AllCaps", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.ExecuteNonQuery() If scmCmdToExecute.Parameters("@printit").Value = 0 Then scmCmdToExecute.Connection.Close() scmCmdToExecute.Dispose() Exit Sub End If objword.Selection.GoTo(What:=Word.WdGoToItem.wdGoToPage, Name:=scmCmdToExecute.Parameters("@page").Value.ToString) Public_barcodeleft = scmCmdToExecute.Parameters("@Left").Value Public_barcodetop = scmCmdToExecute.Parameters("@Top").Value Public_barcodewidth = scmCmdToExecute.Parameters("@Width").Value Public_barcodeheight = scmCmdToExecute.Parameters("@Height").Value HeaderFooterAnzeigen() For Each wx As Word.Shape In objword.Selection.HeaderFooter.Shapes If wx.Name = "RegionenTextFeld" Then wx.Delete() Next Dim ws As Word.Shape ws = objword.Selection.HeaderFooter.Shapes.AddTextbox(1, Public_barcodeleft, Public_barcodetop, _ Public_barcodewidth#, Public_barcodeheight) ws.Name = "RegionenTextFeld" ws.Select() objword.Selection.ShapeRange.Line.Visible = Office.Core.MsoTriState.msoFalse objword.Selection.ShapeRange.TextFrame.MarginLeft = 0.0# objword.Selection.ShapeRange.TextFrame.MarginRight = 0.0# objword.Selection.ShapeRange.TextFrame.MarginTop = 0.0# objword.Selection.ShapeRange.TextFrame.MarginBottom = 0.0# objword.Selection.TypeText(scmCmdToExecute.Parameters("@Inhalt").Value) objword.Selection.Collapse() objword.Selection.HomeKey(Unit:=Word.WdUnits.wdLine, Extend:=Word.WdMovementType.wdExtend) objword.Selection.Font.Name = scmCmdToExecute.Parameters("@Font").Value objword.Selection.Font.Size = scmCmdToExecute.Parameters("@FontSize").Value objword.Selection.Font.Spacing = scmCmdToExecute.Parameters("@Spacing").Value If scmCmdToExecute.Parameters("@Allcaps").Value = 1 Then objword.Selection.Font.AllCaps = scmCmdToExecute.Parameters("@Allcaps").Value End If objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekMainDocument Catch ex As Exception Finally scmCmdToExecute.Connection.Close() scmCmdToExecute.Dispose() 'MsgBox(ex.Message) End Try Catch ex As Exception MsgBox(ex.Message) Finally End Try End Sub #End Region Dim mailbody As String Public Function Sendmail(ByVal email As String, ByVal msg As Integer, ByVal counter As Integer) As Boolean 'Mails im Fehler- bzw. im OK-Fall versenden Dim meldung As String = "" Dim betreff As String = "" Select Case msg Case 0 betreff = "EDKB09 - Return 0: Serienbriefgenerierung druchgeführt / " + Format(Now, "yyyyMMddHHmmss") meldung = "Die Verarbeitung EDKB09 wurde ordnungsgemäss durchgeführt:" + vbCrLf + vbCrLf + _ MailText + vbCrLf + vbCrLf + _ "Dieses Mail wurde durch den Job EDKB09 ausgelöst" + vbCrLf + _ "------------------------------------------------" Case 1 betreff = "EDKB09 - Return 16: Fehler bei der Serienbriefgenerierung / " + Format(Now, "yyyyMMddHHmmss") meldung = "Die Verarbeitung EDKB16 wurde nicht ordnungsgemäss durchgeführt:" + vbCrLf + vbCrLf + _ "Anzahl korrekt verarbeitet: " + counter.ToString + vbCrLf + vbCrLf + _ MailText + vbCrLf + vbCrLf + _ "Dieses Mail wurde durch den Job EDKB09 ausgelöst" + vbCrLf + _ "------------------------------------------------" End Select Dim scmCmdToExecute As SqlCommand = New SqlCommand scmCmdToExecute.CommandText = "dbo.SP_SendMail" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable scmCmdToExecute.Parameters.Add(New SqlParameter("@email", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, email)) scmCmdToExecute.Parameters.Add(New SqlParameter("@betreff", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, betreff)) scmCmdToExecute.Parameters.Add(New SqlParameter("@meldung", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, meldung)) scmCmdToExecute.Connection = conn_edoka.scoDBConnection Try conn_edoka.OpenConnection() Catch End Try Sendmail = True Try scmCmdToExecute.ExecuteNonQuery() Catch ex As Exception Sendmail = False Finally scmCmdToExecute.Dispose() conn_edoka.CloseConnection(True) End Try End Function End Module