Imports System.Data Imports System.Data.SqlClient Imports System.Data.SqlTypes Imports System.IO Imports System.Data.OleDb Imports UtilityLibrary.Win32 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 ImageList1 As System.Windows.Forms.ImageList Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container() Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(frmtextmarken)) Me.ToolBar1 = New System.Windows.Forms.ToolBar() Me.ToolBarButton2 = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton1 = New System.Windows.Forms.ToolBarButton() Me.ImageList1 = New System.Windows.Forms.ImageList(Me.components) Me.Panel1 = New System.Windows.Forms.Panel() Me.SuspendLayout() ' 'ToolBar1 ' Me.ToolBar1.Buttons.AddRange(New System.Windows.Forms.ToolBarButton() {Me.ToolBarButton2, Me.ToolBarButton1}) Me.ToolBar1.DropDownArrows = True Me.ToolBar1.ImageList = Me.ImageList1 Me.ToolBar1.Name = "ToolBar1" Me.ToolBar1.ShowToolTips = True Me.ToolBar1.Size = New System.Drawing.Size(344, 25) Me.ToolBar1.TabIndex = 0 ' 'ToolBarButton2 ' Me.ToolBarButton2.ImageIndex = 0 ' 'ToolBarButton1 ' Me.ToolBarButton1.ImageIndex = 1 Me.ToolBarButton1.Style = System.Windows.Forms.ToolBarButtonStyle.ToggleButton ' 'ImageList1 ' Me.ImageList1.ColorDepth = System.Windows.Forms.ColorDepth.Depth8Bit Me.ImageList1.ImageSize = New System.Drawing.Size(16, 16) Me.ImageList1.ImageStream = CType(resources.GetObject("ImageList1.ImageStream"), System.Windows.Forms.ImageListStreamer) Me.ImageList1.TransparentColor = System.Drawing.Color.Transparent ' 'Panel1 ' Me.Panel1.Dock = System.Windows.Forms.DockStyle.Fill Me.Panel1.Location = New System.Drawing.Point(0, 25) Me.Panel1.Name = "Panel1" Me.Panel1.Size = New System.Drawing.Size(344, 476) Me.Panel1.TabIndex = 1 ' 'frmtextmarken ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13) Me.ClientSize = New System.Drawing.Size(344, 501) Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.Panel1, Me.ToolBar1}) Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon) Me.Name = "frmtextmarken" Me.Text = "Dokumentbefüllung bearbeiten" Me.ResumeLayout(False) End Sub #End Region #Region "Deklarationen" Dim serienbriefnr As Integer Dim DokumentBearbeitungDurchUser As Boolean Dim WithEvents objword As Word.Application Dim WithEvents objdoc As 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 #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 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 #End Region #Region "Load" Public Sub New(ByVal serienbriefnr As Integer, ByVal DokumentBearbeitungDurchUser As Boolean, ByVal dsempfaenger As DataSet, ByVal dokumenttypnr As Integer) MyBase.New() InitializeComponent() Me.serienbriefnr = serienbriefnr Me.DokumentBearbeitungDurchUser = DokumentBearbeitungDurchUser Me.dsempfaenger = dsempfaenger Me.Dokumenttypnr = dokumenttypnr 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() End Sub #End Region #Region "Office" Public Sub Load_Document(Optional ByVal visible As Boolean = True) Dim dokumentname As String = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Me.serienbriefnr.ToString + "_vorlage.doc" Vorlage_Auslesen() StartWord(True) objword.Documents.Open(dokumentname) objdoc = objword.ActiveDocument objword.Visible = visible objword.WindowState = Word.WdWindowState.wdWindowStateMaximize End Sub Private Function StartWord(Optional ByVal newinstance As Boolean = False) Try If newinstance = False Then objword = GetObject(, "Word.application") Else objword = CreateObject("Word.application") End If Catch Try objword = CreateObject("Word.application") Catch ex As Exception End Try Finally objword.Visible = False End Try Try objword.Run("Autoexec") Catch End Try 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 Me.objdoc = Nothing Me.objword = Nothing Exit Function End If If Me.DokumentBearbeitungDurchUser = True Then Me.objword.ActiveDocument.Save() Me.objdoc = Me.objword.ActiveDocument Application.DoEvents() 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 Me.objdoc = Nothing Me.objword = Nothing Me.Vorlage_Speichern() Exit Function End If Application.DoEvents() If Me.objword.Documents.Count = 1 Then Me.objword.Quit(savechanges:=False) End If Me.objdoc = Nothing Me.objword = Nothing Application.DoEvents() 'Me.Vorlage_Speichern() Catch 'MyMsg.show_standardmessage(728, MsgBoxStyle.Critical) End Try End Function #End Region #Region "Datenzugriffe" Private Function Vorlage_Auslesen() As Boolean Try Dim dokumentname = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Me.serienbriefnr.ToString + "_vorlage.doc" 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) 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 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 = "" Dim dokumentname = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Me.serienbriefnr.ToString + "_vorlage.doc" 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 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 Connection.Open() DA.Fill(ds, "vorlage") Dim myRow As DataRow 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:=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:=Word.WdGoToItem.wdGoToBookmark, Name:=TMName) Activate_Word() Catch ex As Exception End Try Else Try objword.Selection.GoTo(what:=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 Try s = objword.ActiveDocument.FormFields.Item(row.Item("feldname")).Name() 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 Private Sub objdoc_DocumentEvents_Event_Close() Handles objdoc.Close Me.Close() End Sub End Class