Imports System.Data Imports System.Data.SqlClient Imports System.Data.SqlTypes Imports System.IO Imports System.Data.OleDb Imports UtilityLibrary.Win32 Imports System.Threading Public Class frmtextmarken Inherits System.Windows.Forms.Form #Region " Vom Windows Form Designer generierter Code " Public Sub New() MyBase.New() ' Dieser Aufruf ist für den Windows Form-Designer erforderlich. InitializeComponent() ' Initialisierungen nach dem Aufruf InitializeComponent() hinzufügen End Sub ' Die Form überschreibt den Löschvorgang der Basisklasse, um Komponenten zu bereinigen. Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then If Not (components Is Nothing) Then components.Dispose() End If End If MyBase.Dispose(disposing) End Sub ' Für Windows Form-Designer erforderlich Private components As System.ComponentModel.IContainer 'HINWEIS: Die folgende Prozedur ist für den Windows Form-Designer erforderlich 'Sie kann mit dem Windows Form-Designer modifiziert werden. 'Verwenden Sie nicht den Code-Editor zur Bearbeitung. Friend WithEvents ToolBar1 As System.Windows.Forms.ToolBar Friend WithEvents ToolBarButton1 As System.Windows.Forms.ToolBarButton Friend WithEvents Panel1 As System.Windows.Forms.Panel Friend WithEvents ToolBarButton2 As System.Windows.Forms.ToolBarButton Friend WithEvents tsbtnpreview As System.Windows.Forms.ToolBarButton Friend WithEvents cbpartner As System.Windows.Forms.ComboBox Friend WithEvents ImageList1 As System.Windows.Forms.ImageList Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(frmtextmarken)) Me.ToolBar1 = New System.Windows.Forms.ToolBar Me.ToolBarButton2 = New System.Windows.Forms.ToolBarButton Me.ToolBarButton1 = New System.Windows.Forms.ToolBarButton Me.tsbtnpreview = New System.Windows.Forms.ToolBarButton Me.ImageList1 = New System.Windows.Forms.ImageList(Me.components) Me.Panel1 = New System.Windows.Forms.Panel Me.cbpartner = New System.Windows.Forms.ComboBox Me.SuspendLayout() ' 'ToolBar1 ' Me.ToolBar1.Buttons.AddRange(New System.Windows.Forms.ToolBarButton() {Me.ToolBarButton2, Me.ToolBarButton1, Me.tsbtnpreview}) Me.ToolBar1.DropDownArrows = True Me.ToolBar1.ImageList = Me.ImageList1 Me.ToolBar1.Location = New System.Drawing.Point(0, 0) Me.ToolBar1.Name = "ToolBar1" Me.ToolBar1.ShowToolTips = True Me.ToolBar1.Size = New System.Drawing.Size(344, 28) Me.ToolBar1.TabIndex = 0 ' 'ToolBarButton2 ' Me.ToolBarButton2.ImageIndex = 0 Me.ToolBarButton2.Name = "ToolBarButton2" ' 'ToolBarButton1 ' Me.ToolBarButton1.ImageIndex = 1 Me.ToolBarButton1.Name = "ToolBarButton1" Me.ToolBarButton1.Style = System.Windows.Forms.ToolBarButtonStyle.ToggleButton ' 'tsbtnpreview ' Me.tsbtnpreview.ImageIndex = 2 Me.tsbtnpreview.Name = "tsbtnpreview" Me.tsbtnpreview.ToolTipText = "Vorschau" ' 'ImageList1 ' Me.ImageList1.ImageStream = CType(resources.GetObject("ImageList1.ImageStream"), System.Windows.Forms.ImageListStreamer) Me.ImageList1.TransparentColor = System.Drawing.Color.Transparent Me.ImageList1.Images.SetKeyName(0, "") Me.ImageList1.Images.SetKeyName(1, "") Me.ImageList1.Images.SetKeyName(2, "Lupe2.png") ' 'Panel1 ' Me.Panel1.Dock = System.Windows.Forms.DockStyle.Fill Me.Panel1.Location = New System.Drawing.Point(0, 28) Me.Panel1.Name = "Panel1" Me.Panel1.Size = New System.Drawing.Size(344, 473) Me.Panel1.TabIndex = 1 ' 'cbpartner ' Me.cbpartner.FormattingEnabled = True Me.cbpartner.Location = New System.Drawing.Point(79, 3) Me.cbpartner.Name = "cbpartner" Me.cbpartner.Size = New System.Drawing.Size(253, 21) Me.cbpartner.TabIndex = 2 ' 'frmtextmarken ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13) Me.ClientSize = New System.Drawing.Size(344, 501) Me.Controls.Add(Me.cbpartner) Me.Controls.Add(Me.Panel1) Me.Controls.Add(Me.ToolBar1) Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon) Me.Name = "frmtextmarken" Me.Text = "Dokumentbefüllung bearbeiten" Me.ResumeLayout(False) Me.PerformLayout() End Sub #End Region #Region "Deklarationen" Dim serienbriefnr As Integer Dim DokumentBearbeitungDurchUser As Boolean Dim WithEvents objword As Microsoft.Office.Interop.Word.Application Dim WithEvents objdoc As Microsoft.Office.Interop.Word.Document Dim stdvorlagenfelder As New DataTable() Dim dsempfaenger As New DataSet() Dim WithEvents ucedit As New ucedit() Dim WithEvents ucnoedit As New ucnoedit() Dim m_dokumenttypnr As Integer Property Dokumenttypnr() As Integer Get Return m_dokumenttypnr End Get Set(ByVal Value As Integer) m_dokumenttypnr = Value End Set End Property Public Event Vorschau(ByVal Filename As String, ByVal bpnr As Integer) #End Region #Region "Ereignisse" Private Sub ToolBar1_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles ToolBar1.ButtonClick Select Case ToolBar1.Buttons.IndexOf(e.Button) Case 0 'Exit Me.Close() Case 1 If Me.ToolBarButton1.Pushed Then Me.Height = 50 Else Me.Height = 450 + Me.ToolBar1.Height + 10 End If Case 2 objword.ActiveDocument.Save() 'Rel. Office 2010 Dim dokumentname = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Me.serienbriefnr.ToString + "_vorlage" + System.IO.Path.GetExtension(objword.ActiveDocument.Name) 'Rel. Office 2010 FileCopy(dokumentname, dokumentname + "_Preview" + System.IO.Path.GetExtension(objword.ActiveDocument.Name)) Dim bpnr As Integer Dim i As Integer Dim pnr As Integer i = Me.cbpartner.Text.ToString.IndexOf("-") pnr = Me.cbpartner.Text.ToString.Substring(0, i - 1) pnr = Trim(pnr) bpnr = pnr 'Rel. Office 2010 RaiseEvent Vorschau(dokumentname + "_Preview" + System.IO.Path.GetExtension(dokumentname), bpnr) Case Else End Select End Sub Dim Schliessen_OK As Boolean = False Private Sub frmtextmarken_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing Schliessen_OK = True Me.Save_Office() End Sub Private Sub document_beforeclose(ByVal Doc As Microsoft.Office.Interop.Word.Document, ByRef Cancel As Boolean) Handles objword.DocumentBeforeClose If Doc.Name = sbdokumentname And Not Schliessen_OK Then MsgBox("Bitte schliessen Sie das Dokument durch schliessen des Fensters 'Dokumentbefüllung bearbeiten'.", vbInformation) Cancel = True End If End Sub #End Region #Region "Load" Public Sub New(ByVal serienbriefnr As Integer, ByVal DokumentBearbeitungDurchUser As Boolean, ByVal dsempfaenger As DataSet, ByVal dokumenttypnr As Integer, Optional ByVal Vorlagendaten As DataTable = Nothing, Optional ByVal tmpempfaenger As DataSet = Nothing, Optional ByVal Vorschau_Aktivieren As Boolean = False) MyBase.New() InitializeComponent() Me.serienbriefnr = serienbriefnr Me.DokumentBearbeitungDurchUser = DokumentBearbeitungDurchUser Me.dsempfaenger = dsempfaenger Me.Dokumenttypnr = dokumenttypnr 'Rel. 4.1 If Not Vorlagendaten Is Nothing Then Me.Filldoc = True Me.vorlagendaten = Vorlagendaten Me.tmpempfaenger = tmpempfaenger Else Filldoc = False End If If Vorschau_Aktivieren = True Then Me.tsbtnpreview.Visible = True Me.cbpartner.Visible = True For Each dr As DataRow In Me.dsempfaenger.Tables(0).Rows Me.cbpartner.Items.Add(dr.Item("Partnernr").ToString + " - " + dr.Item("Kurzbezeichnung").ToString) Next Me.cbpartner.SelectedIndex = 0 Else Me.tsbtnpreview.Visible = False Me.cbpartner.Visible = False End If End Sub Private Sub frmtextmarken_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Application.DoEvents() Me.Cursor = Cursors.WaitCursor Me.TopMost = True Me.Load_Document() If Me.DokumentBearbeitungDurchUser = True Then Me.Panel1.Controls.Add(ucedit) Me.ucedit.Dock = DockStyle.Fill Me.Height = 450 + Me.ToolBar1.Height + 10 Else Me.Panel1.Controls.Add(ucnoedit) Me.Height = 450 + Me.ToolBar1.Height + 10 End If Me.Cursor = Cursors.Default Application.DoEvents() 'Rel. 4.1 If Me.Filldoc = True Then Me.Dokumente_Generieren() End If End Sub #End Region #Region "Office" Dim sbdokumentname As String = "" Public Sub Load_Document(Optional ByVal visible As Boolean = True) 'Rel. Office 2010 Dim dokumentname As String = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Me.serienbriefnr.ToString + "_vorlage.docx" Vorlage_Auslesen(dokumentname) StartWord(True) objword.Documents.Open(dokumentname) objdoc = objword.ActiveDocument If visible = True Then sbdokumentname = objdoc.Name objword.Visible = visible objword.WindowState = Microsoft.Office.Interop.Word.WdWindowState.wdWindowStateMaximize End Sub Private Function StartWord(Optional ByVal newinstance As Boolean = False) Try If Globals.Office_2010_Always_New_Word = True Then objword = CreateObject("Word.Application") Else objword = GetObject(, "Word.Application") objword.Application.Options.SaveInterval = 0 End If Catch Try objword = CreateObject("Word.Application") objword.Application.Options.SaveInterval = 0 Catch ex As Exception MsgBox(ex.Message) End Try Finally objword.Visible = False End Try Try If Globals.Office_2010_Word_Autoexec = True Then Thread.Sleep(Globals.Office_2010_Word_Start_Delay) objword.Run("Autoexec") Else Try Dim addinfile As String = DivFnkt.XML_Param("TKBMakroLib") Thread.Sleep(Globals.Office_2010_Word_Start_Delay) If addinfile <> "" Then objword.AddIns.Add(addinfile) Catch ex As Exception MsgBox(ex.Message) End Try End If Catch ex As Exception DivFnkt.TraceLog("-----------Fehler Autoexec Ende") End Try 'Me.Errormessage = "15" End Function Private Function Save_Office(Optional ByVal savetodb As Boolean = True) Try If Not savetodb Then Me.objdoc = Me.objword.ActiveDocument Application.DoEvents() Me.objdoc.Close(Savechanges:=False) Application.DoEvents() Threading.Thread.CurrentThread.Sleep(400) If Me.objword.Documents.Count = 0 Then Me.objword.Quit(savechanges:=False) End If Try Me.objdoc = Nothing Catch End Try Try Me.objword = Nothing Catch End Try Exit Function End If If Me.DokumentBearbeitungDurchUser = True Then Me.objword.ActiveDocument.Save() Me.objdoc = Me.objword.ActiveDocument Application.DoEvents() If Me.Filldoc = True Then Delete_Generierte_Bookmarks() Me.objdoc.Close(savechanges:=True) Application.DoEvents() Threading.Thread.CurrentThread.Sleep(400) If Me.objword.Documents.Count = 0 Then Me.objword.Quit(SaveChanges:=False) End If Try Me.objdoc = Nothing Catch End Try Try Me.objword = Nothing Catch End Try Me.Vorlage_Speichern() Exit Function End If Application.DoEvents() If Me.objword.Documents.Count = 1 Then Me.objword.Quit(savechanges:=False) End If Try Me.objdoc = Nothing Catch End Try Try Me.objword = Nothing Catch End Try Application.DoEvents() 'Me.Vorlage_Speichern() Catch ex As Exception 'MyMsg.show_standardmessage(728, MsgBoxStyle.Critical) End Try End Function #End Region #Region "Datenzugriffe" Private Function Vorlage_Auslesen(Optional ByRef dateiname As String = "") As Boolean Try 'Rel. Office 2010 Dim dokumentname = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Me.serienbriefnr.ToString + "_vorlage.docx" Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from edex_sb_vorlage where serienbriefnr=" + Str(Me.serienbriefnr), Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Try Connection.ConnectionString = Globals.sConnectionString Connection.Open() DA.Fill(ds, "empf") Dim myRow As DataRow If ds.Tables(0).Rows.Count = 0 Then MyMsg.show_standardmessage(715, MsgBoxStyle.Critical) Else myRow = ds.Tables(0).Rows(0) Dim MyData() As Byte MyData = myRow.Item(1) Dim K As Long K = UBound(MyData) dokumentname = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Me.serienbriefnr.ToString + "_vorlage" + myRow.Item(2) Dim fs As New FileStream(dokumentname, FileMode.OpenOrCreate, FileAccess.Write) fs.Write(MyData, 0, K) fs.Close() fs = Nothing dateiname = dokumentname End If Catch ex As Exception MyMsg.show_standardmessage(717, MsgBoxStyle.Critical) ' MsgBox(ex.Message) Return False End Try cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing Return True Catch EX As Exception MyMsg.show_standardmessage(717, MsgBoxStyle.Critical) Return False End Try End Function Private Sub Vorlage_Speichern() 'Dokumentvorlage aus Office-Vorlage-Datei auslesen, sofern Filename = "" 'Rel. Office 2010 Dim dokumentname = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Me.serienbriefnr.ToString + "_vorlage.docx" Try Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from edex_sb_vorlage where serienbriefnr=" + Str(Me.serienbriefnr), Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Dim fs As FileStream Try Connection.ConnectionString = Globals.sConnectionString Connection.Open() DA.Fill(ds, "vorlage") Dim myRow As DataRow myRow = ds.Tables(0).Rows(0) dokumentname = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Me.serienbriefnr.ToString + "_vorlage" + myRow.Item(2) fs = New FileStream(dokumentname, FileMode.Open, FileAccess.Read) Dim mydata(fs.Length) As Byte fs.Read(mydata, 0, fs.Length) fs.Close() If ds.Tables(0).Rows.Count = 0 Then 'Neue Serienbrief_Empfaenger speichern myRow = ds.Tables(0).NewRow myRow.Item(0) = Me.serienbriefnr myRow.Item(1) = mydata ds.Tables(0).Rows.Add(myRow) DA.Update(ds, "vorlage") Else ' Bestehende Empfängerliste überschreiben myRow = ds.Tables(0).Rows(0) myRow.Item(1) = mydata DA.Update(ds, "vorlage") End If Catch ex As Exception MyMsg.show_standardmessage(718, MsgBoxStyle.Critical) ' MsgBox(ex.Message) End Try fs = Nothing cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing Catch ex As Exception Finally Try Application.DoEvents() File.Delete(dokumentname) Catch End Try End Try End Sub Private Function Get_Vorlagenfelder(ByVal type As Integer) As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim i As Integer Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) scmCmdToExecute.CommandText = "dbo.sp_edex_sb_get_standardvorlagenfelder" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = conn.scoDBConnection Try scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttypnr", SqlDbType.Int, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.Dokumenttypnr)) scmCmdToExecute.Parameters.Add(New SqlParameter("@type", SqlDbType.Int, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, type)) 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 #End Region #Region "UC-Ereignisse" Private Function Activate_Word() Dim hnd As Long hnd = Win32API.FindWindow("Opusapp", vbNullString) Win32API.SetForegroundWindow(hnd) End Function Private Sub ucedit_insert_tm(ByVal TMName As String, ByVal isfield As Boolean) Handles ucedit.OnInsert_TM Try If isfield = False Then objword.Selection.Bookmarks.Add(TMName) Else objword.Selection.FormFields.Add(Range:=objword.Selection.Range, Type:=Microsoft.Office.Interop.Word.WdFieldType.wdFieldFormTextInput) objword.Selection.PreviousField.Select() objword.Selection.FormFields.Item(1).Name = TMName End If Activate_Word() Catch End Try End Sub Private Sub ucedit_goto_tm(ByVal TMName As String, ByVal isfield As Boolean) Handles ucedit.OnGoto_TM, ucnoedit.OnGoto_TM If Not isfield Then Try objword.Selection.GoTo(what:=Microsoft.Office.Interop.Word.WdGoToItem.wdGoToBookmark, Name:=TMName) Activate_Word() Catch ex As Exception End Try Else Try objword.Selection.GoTo(what:=Microsoft.Office.Interop.Word.WdGoToItem.wdGoToField, Name:=TMName) Activate_Word() Catch End Try End If End Sub Private Sub ucedit_OnGetStandardvorlagenfelder(ByRef list As System.Data.DataTable) Handles ucedit.OnGetStandardvorlagenfelder list = Me.Get_Vorlagenfelder(0) End Sub Private Sub ucedit_OnGetUsedFelder(ByRef list As System.Data.DataTable) Handles ucedit.OnGetUsedFelder, ucnoedit.OnGetUsedFelder list = Me.dsempfaenger.Tables("UsedFelder") End Sub Private Sub get_usedfelder(ByRef list As System.Data.DataTable) list = Me.Get_Vorlagenfelder(1) Dim i As Integer Dim s As String Dim row As DataRow Dim dodelete As Boolean = False For Each row In list.Rows dodelete = False If row.Item("Feldname") <> "" Then 'ContentControls Try If row.Item("Feldname").ToString.Substring(0, 3) = "cc_" Then s = row.Item("Feldname") Else s = objword.ActiveDocument.FormFields.Item(row.Item("feldname")).Name() End If Catch dodelete = True End Try End If If row.Item("Beginntextmarke") <> "" Then Try s = objword.ActiveDocument.Bookmarks.Item(row.Item("beginntextmarke")).Name Catch dodelete = True End Try End If If row.Item("endetextmarke") <> "" Then Try s = objword.ActiveDocument.Bookmarks.Item(row.Item("endetextmarke")).Name Catch dodelete = True End Try End If If dodelete Then row.Delete() Next End Sub Private Sub ucedit_OnGetIDVFelder(ByRef list As System.Data.DataTable) Handles ucedit.OnGetIDVFelder, ucnoedit.OnGetIDVFelder list = Me.get_idvwerte End Sub Private Sub ucnoedit_OnGetVerknuepfteFelder(ByRef list As System.Data.DataTable) Handles ucnoedit.OnGetVerknuepfteFelder Try list = Me.dsempfaenger.Tables("Verkfelder") Catch End Try If list Is Nothing Then Me.dsempfaenger.Tables.Add("VerkFelder") Dim d1 As New DataColumn() Dim d2 As New DataColumn() Dim d3 As New DataColumn() d1.Caption = "IDVWert" d1.ColumnName = "IDVWert" d1.DefaultValue = "" d2.Caption = "Standardwert" d2.ColumnName = "Standardwert" d2.DefaultValue = "" d3.Caption = "Vorlagenfeldnr" d3.ColumnName = "Vorlagenfeldnr" d3.DefaultValue = "" With Me.dsempfaenger.Tables("Verkfelder").Columns .Add(d1) .Add(d2) .Add(d3) End With list = Me.dsempfaenger.Tables("Verkfelder") End If End Sub Private Function get_idvwerte() As DataTable Dim i As Integer Dim dt As New DataTable() dt.Columns.Add("Feldname") dt.Columns.Add("Wert") For i = 0 To Me.dsempfaenger.Tables(0).Columns.Count - 1 Select Case UCase(Me.dsempfaenger.Tables(0).Columns(i).Caption) Case "PARTNERNR", "KURZBEZEICHNUNG", "ANREDE", "NAME", "VORNAME", "STRASSE", "PLZ", "ORT", "ZUSTELLADRESSE", "BRIEFANREDE1", "BRIEFANREDE2", "STATUS", "FEHLERCD", "BLKUNDE", "DOKUMENT_GEDRUCKT", "AKTIV", "DOKUMENTID", "DOKUMENTIDBDR", "ERSTELLER", "FEHLERCODE", "DRUCKJOBID" Case Else Dim myRow As DataRow myRow = dt.NewRow myRow.Item(0) = Me.dsempfaenger.Tables(0).Columns(i).Caption myRow.Item(1) = "" dt.Rows.Add(myRow) End Select Next Return dt End Function Private Sub ucedit_OnDelete_TM(ByVal TMName As String, ByVal isfield As Boolean) Handles ucedit.OnDelete_TM Try If isfield = False Then objword.ActiveDocument.Bookmarks.Item(TMName).Delete() Activate_Word() Else objword.ActiveDocument.FormFields.Item(TMName).Delete() Activate_Word() End If Catch End Try End Sub #End Region #Region "öffentliche Methoden" Public Function init_used_felder() As DataTable Dim dt As New DataTable() Me.Load_Document(False) Me.get_usedfelder(dt) Me.Save_Office(False) Return dt End Function #End Region 'Rel. 4.1 #Region "Befüllen" Dim doktyp As New edokadb.clsDokumenttyp() Dim serienbrief As New edokadb.clsEdex_sb_serienbrief() Dim vorlagendaten As New DataTable Dim tmpempfaenger As New DataSet Dim officevorlage As New edokadb.clsOffice_vorlage() Dim beginntextmarke As String Dim endetextmarke As String Dim feldname As String Dim dokid As String Dim blkunde As String = "" Dim GenerierteDokumente As New Collection() Dim Filldoc As Boolean = False Private Function Dokumente_Generieren() Dim Kopfzeile As Boolean serienbrief.cpMainConnectionProvider = Globals.conn serienbrief.iSerienbriefnr = New SqlInt32(CType(Me.Serienbriefnr, Int32)) serienbrief.SelectOne() doktyp.cpMainConnectionProvider = Globals.conn doktyp.iDokumenttypnr = serienbrief.iDokumenttypnr doktyp.SelectOne() officevorlage.cpMainConnectionProvider = Globals.conn 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 Microsoft.Office.Interop.Word.Application() 'objword.WindowState = Microsoft.Office.Interop.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 'Rel. Office 2010 Dim dokumentname = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + serienbriefnr.ToString + "_vorlage.docx" 'objword.Documents.Open(dokumentname) 'objword.Visible = False 'objword.WindowState = Microsoft.Office.Interop.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 'If vorlagendaten.Columns(i1).ColumnName = "_Alter" Or vorlagendaten.Columns(i1).ColumnName = "Alter" Or vorlagendaten.Columns(i1).ColumnName = "Alter_" Then ' MsgBox("Gaga") 'End If 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 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 Me.dsempfaenger.Tables("VerkFelder").Rows.Count - 1 If feldnr = Me.dsempfaenger.Tables("verkfelder").Rows(i2).Item("Vorlagenfeldnr").ToString Then vorlagendaten.Rows(i).Item(i1) = vorlagendaten.Rows(i).Item(Me.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) ' Me.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 Delete_Generierte_Bookmarks() Dim i As Integer Dim pos1 As Integer Dim pos2 As Integer Dim hastextmarken As Boolean = True Dim s As String Dim e As String Try While hastextmarken = True hastextmarken = False For i = 1 To objword.ActiveDocument.Bookmarks.Count s = objword.ActiveDocument.Bookmarks.Item(i).Name If Microsoft.VisualBasic.Left(s, 2) = "TS" Then hastextmarken = True delete_it(s) Exit For End If Next End While Catch ex As Exception MsgBox(ex.Message + " :" + s) End Try End Sub Private Sub delete_it(ByVal s As String) Dim pos1 As Integer Dim pos2 As Integer Dim hastextmarken As Boolean = True Dim e As String pos1 = objword.ActiveDocument.Bookmarks.Item(s).Start e = "TE" + Microsoft.VisualBasic.Right(s, Len(s) - 2) pos2 = objword.ActiveDocument.Bookmarks.Item(e).Start objword.Selection.SetRange(Start:=pos1, End:=pos2) objword.Selection.Delete() Try objword.ActiveDocument.Bookmarks.Item(s).Delete() objword.ActiveDocument.Bookmarks.Item(e).Delete() Application.DoEvents() Catch End Try End Sub Private Sub Insert_Value(ByVal feldwert As String, ByVal feldname As String) Dim i As Integer Dim dc As DataRow Dim pos1 As Integer Dim pos2 As Integer If Microsoft.VisualBasic.Left(feldname, 5) = "TMISB" Then beginntextmarke = feldname endetextmarke = "" feldname = "" Else For Each dc In Me.tmpempfaenger.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 If beginntextmarke <> "" And endetextmarke = "" Then Try objword.ActiveDocument.Bookmarks.Item(beginntextmarke).Select() objword.ActiveDocument.Bookmarks.Add("TS" & beginntextmarke) objword.ActiveDocument.Bookmarks.Item("TS" & beginntextmarke).Select() objword.Selection.MoveRight(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1) objword.ActiveDocument.Bookmarks.Add("TE" & beginntextmarke) objword.ActiveDocument.Bookmarks.Item("TS" & beginntextmarke).Select() objword.Selection.TypeText(Text:=feldwert) Catch ex As Exception End Try End If If beginntextmarke <> "" And endetextmarke <> "" Then Try objword.ActiveDocument.Bookmarks.Item(beginntextmarke).Select() objword.ActiveDocument.Bookmarks.Add("TS" & beginntextmarke) objword.ActiveDocument.Bookmarks.Item(endetextmarke).Select() objword.ActiveDocument.Bookmarks.Add("TE" & beginntextmarke) pos1 = objword.ActiveDocument.Bookmarks.Item("TS" & beginntextmarke).Start pos2 = objword.ActiveDocument.Bookmarks.Item("TE" & 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 Sub Insert_Kopfzeile() objword.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdStory) If objword.ActiveWindow.View.SplitSpecial <> Microsoft.Office.Interop.Word.WdSpecialPane.wdPaneNone Then objword.ActiveWindow.Panes.Item(2).Close() End If If objword.ActiveWindow.ActivePane.View.Type = Microsoft.Office.Interop.Word.WdViewType.wdNormalView Or objword.ActiveWindow.ActivePane.View.Type = Microsoft.Office.Interop.Word.WdViewType.wdOutlineView Then objword.ActiveWindow.ActivePane.View.Type = Microsoft.Office.Interop.Word.WdViewType.wdPrintView End If objword.ActiveWindow.ActivePane.View.SeekView = Microsoft.Office.Interop.Word.WdSeekView.wdSeekCurrentPageHeader set_headerbookmark() objword.ActiveWindow.ActivePane.View.SeekView = Microsoft.Office.Interop.Word.WdSeekView.wdSeekMainDocument End Sub Private Sub set_headerbookmark() Try objword.ActiveDocument.Bookmarks.Item("TGEDKCompanyBBEB99").Select() Catch objword.Selection.MoveDown(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdLine, Count:=1) With objword.ActiveDocument.Bookmarks .Add(Range:=objword.Selection.Range, Name:="TGEDKCompanyBBEB99") .DefaultSorting = Microsoft.Office.Interop.Word.WdBookmarkSortBy.wdSortByName .ShowHidden = False End With End Try End Sub #End Region Private Sub objdoc_DocumentEvents_Event_Close() Handles objdoc.Close Me.Close() End Sub End Class