shu
/
EDKB09_DMS
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
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.
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'master'
${ noResults }
EDKB09_DMS/Main.vb

1982 lines
91 KiB
Raw Permalink Blame History Escape

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<70>ngerklasse Instanzieren und Empf<70>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<73>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<6B>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<EFBFBD>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<6B>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<EFBFBD>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<70>ngerliste <20>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<65>hrt / " + Format(Now, "yyyyMMddHHmmss")
meldung = "Die Verarbeitung EDKB09 wurde ordnungsgem<65>ss durchgef<65>hrt:" + vbCrLf + vbCrLf + _
MailText + vbCrLf + vbCrLf + _
"Dieses Mail wurde durch den Job EDKB09 ausgel<65>st" + vbCrLf + _
"------------------------------------------------"
Case 1
betreff = "EDKB09 - Return 16: Fehler bei der Serienbriefgenerierung / " + Format(Now, "yyyyMMddHHmmss")
meldung = "Die Verarbeitung EDKB16 wurde nicht ordnungsgem<65>ss durchgef<65>hrt:" + vbCrLf + vbCrLf + _
"Anzahl korrekt verarbeitet: " + counter.ToString + vbCrLf + vbCrLf + _
MailText + vbCrLf + vbCrLf + _
"Dieses Mail wurde durch den Job EDKB09 ausgel<65>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
Reference in new issue View Git Blame Copy Permalink