shu
/
EDOKA_Client
1
0
Fork 0
Code Issues Pull Requests 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 }
EDOKA_Client/EDOKA/Backup1/Office/WordLib.vb

4445 lines
186 KiB
Raw Permalink Blame History Escape

Imports System.IO
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Imports System.Threading
Imports Word
Public Class WordLib
#Region "Deklarationen"
'FileObjekte
Dim objWatcher As New System.IO.FileSystemWatcher()
Dim objResult As System.IO.WaitForChangedResult
'Word
Private WithEvents objWord As Word.Application
Private WithEvents docWord As Word.Document
Private WithEvents objExcel As Excel.Application
Private WithEvents docExcel As Excel.Workbook
'Applicationwatcher
Private WithEvents WordWatch As New ApplicationFileWatcher()
'Dokumentdaten
Dim dokudata As New edokadb.clsMyDokumentDaten()
Dim Dokumentdaten As DataTable
Dim DokumenTtyp As New edokadb.clsDokumenttyp()
Dim Office_Vorlage As New edokadb.clsOffice_vorlage()
'Interne Variablen
Dim isactiv As Boolean
Dim Dokument_To_Create As String
Dim Dokument_To_Save As String
Dim Dokument_Temp As String
Dim Cursor_Positionieren As Boolean
Dim IsProtected As Boolean
Dim inEditMode As Boolean
Dim timerloop As Integer
Dim Word_Active As Boolean
Dim m_DokumentID As String
Dim m_dokumentidbr As String
Dim m_DokumentTypnr As Long
Dim m_amsdokument As Bookmark
Dim m_DokumentFilename As String
Dim m_DokumentDatum As DateTime
Dim m_Dokumentname As String
Dim m_CreateDoc As Boolean
Dim m_document_saved As Boolean
Dim CheckDokumentname As String
Dim WordnewInstance As Boolean
Dim m_sKopyDokID As String = ""
'IDV-Definitionen
Private m_objdc As dc.Application
Dim xx As dc.Application
Dim idvdll As Object
'Dim idvdll As New IDVMakros.Application()
Dim OhneIDV As Boolean = False
'IDV-Definitionen, sofern IDV nicht vorhanden ist (Entwicklung)
'Dim dc As Object
'Dim m_objdc As Object
'Dim idvdll As Object
'Dim xx As Object
'Private dckein As Integer
'Private dcinvisible As Integer
'Private dcMTBS As Long
'Dim OhneIDV As Boolean = True
'Progressbar
Public ProgressBar As New frmProgress(True)
'Datentabellen
Public Save_Dokument As New DataTable()
Public Save_Notizen As New DataTable()
Public Save_ColdIndex As DataTable
Public Save_Dokumentwerte As DataTable
Public Save_Dokumentzuordnungen As DataTable
Public Save_Dokumentinfomeldungen As DataTable
Public Save_DokumentFunktionen As DataTable
Public save_historystatus As Integer
Public save_dokumentersetzen As DataTable
Public save_dokumentcoldindex As DataTable
Public Save_Dokumentbr As New DataTable()
Public Save_Notizenbr As New DataTable()
Public Save_ColdIndexbr As DataTable
Public Save_Dokumentwertebr As DataTable
Public Save_Dokumentzuordnungenbr As DataTable
Public Save_Dokumentinfomeldungenbr As DataTable
Public Save_DokumentFunktionenbr As DataTable
Public save_historystatusbr As Integer
Public save_dokumentersetzenbr As DataTable
Public save_dokumentcoldindexbr As DataTable
Public Dokumentcoldindex_Changed As Boolean
Public Dokumentcoldindex_changedbr As Boolean
Public dokumentcoldindex_status As String
Public dokumentcoldindex_statusbr As String
Public dokumentid_changed As Boolean
Public dokumentid_changedbr As Boolean
Public dokumentidalt As String
Public dokumentidaltbr As String
Public Ersetzte_Dokumente_Reaktivieren As Boolean
Public Ersetzte_Dokumente_Reaktivierenbr As Boolean
Public txtBemerkung_Verantwortlicher As String
Public save_verantwortlicher As Integer
Public save_stv As Integer
Dim Save_DateTime As DateTime
Dim Excel_Dokument As Boolean
Dim DocReadonly As Boolean
Dim m_txtpartner As String
Property txtPartner() As String
Get
Return m_txtpartner
End Get
Set(ByVal Value As String)
m_txtpartner = Value
End Set
End Property
Dim m_txtdokumenttyp As String
Property txtDokumenttyp() As String
Get
Return m_txtdokumenttyp
End Get
Set(ByVal Value As String)
m_txtdokumenttyp = Value
End Set
End Property
'Events
Public Event OfficeFinished()
Public send_statusmessage As Boolean
Dim Finished As Boolean = False
Dim M_Errormessage As String
Property Errormessage() As String
Get
Return M_Errormessage
End Get
Set(ByVal Value As String)
M_Errormessage = Value
End Set
End Property
'EDEX Banklagernd
Public bldokument As Boolean = False
Public bldelquittungkube As Boolean = False
Public BLQuittungstext As String = ""
Public BLUnterschrift1 As String = ""
Public BLUnterschrift2 As String = ""
Public BLDel2Page As Boolean = False
Public BLAdresse1 As String = ""
Public BLAdresse2 As String = ""
Public SaveBLDossier As Boolean = False
#End Region
#Region "Properties"
Property Dokumenttypnr() As Long
Get
Return m_DokumentTypnr
End Get
Set(ByVal Value As Long)
m_DokumentTypnr = Value
End Set
End Property
Property Dokument_Saved() As Boolean
Get
Return m_document_saved
End Get
Set(ByVal Value As Boolean)
m_document_saved = Value
End Set
End Property
Property DokumentID() As String
Get
Return m_DokumentID
End Get
Set(ByVal Value As String)
m_DokumentID = Value
End Set
End Property
Property Dokumentidbr() As String
Get
Return m_dokumentidbr
End Get
Set(ByVal Value As String)
m_dokumentidbr = Value
End Set
End Property
Property DokumentName() As String
Get
Return m_Dokumentname
End Get
Set(ByVal Value As String)
m_Dokumentname = Value
End Set
End Property
Property Dokumentfilename() As String
Get
Return m_DokumentFilename
End Get
Set(ByVal Value As String)
m_DokumentFilename = Value
End Set
End Property
Property DokumentDatum() As DateTime
Get
Return m_DokumentDatum
End Get
Set(ByVal Value As DateTime)
m_DokumentDatum = Value
End Set
End Property
Property CreateDoc() As Boolean
Get
Return m_CreateDoc
End Get
Set(ByVal Value As Boolean)
m_CreateDoc = Value
End Set
End Property
#End Region
#Region "IDVP-Funktionen"
Public Sub Cancel_IDVPortfeuille()
Me.Errormessage = "207"
Dim hwnd As Long
Me.Errormessage = "1"
hwnd = Win32API.FindWindow(vbNullString, "DC")
While hwnd <> 0
Dim s As String
s = MyTxt.gettext(87)
Dim f As New frmHinweismeldung1()
f.Label1.Text = s
f.MsgBoxStyle = 1
f.ShowDialog()
f.Dispose()
Dim myProcess() As Process
'Dim id As System.Diagnostics.Process
'Dim xxx As Long
Try
myProcess = Process.GetProcessesByName("DC")
'BUD - 2006-05-08 Fehler in Vista, IDVP kann nicht gekillt werden
'myProcess(0).Kill()
If myProcess(0).HasExited = False Then
If myProcess(0).CloseMainWindow() = False Then
Try
myProcess(0).Kill()
Catch
End Try
End If
End If
Thread.Sleep(500)
Catch
Finally
hwnd = Win32API.FindWindow(vbNullString, "DC")
End Try
End While
' 'Exit Sub
' Try
' xx = CreateObject("DC.APPLICATION")
' xx.Quit()
' Catch
' End Try
Me.Errormessage = "2"
End Sub
Private Sub Init_IDV_Variablen()
Me.Errormessage = "3"
On Error Resume Next
'Diverse Felder
'm_objdc.DokVarClear("VarHerkunft")
m_objdc.DokVarAdd("VarHerkunft", "EDOKA")
m_objdc.DokVarAdd("VarSchuldner", " ")
m_objdc.DokVarAdd("VarAdresseVorname", " ")
'Bankangaben
m_objdc.DokVarAdd("VarCompanyName", " ")
m_objdc.DokVarAdd("VarCompanyBankname", " ")
m_objdc.DokVarAdd("VarCompanyAdresse1", " ")
m_objdc.DokVarAdd("VarCompanyAdresse2", " ")
m_objdc.DokVarAdd("VarCompanyAdresse3", " ")
m_objdc.DokVarAdd("VarCompanyBankbetriebseinheit", " ")
m_objdc.DokVarAdd("VarCompanyBBENr", " ")
m_objdc.DokVarAdd("VarCompanyBBEOrt", " ")
m_objdc.DokVarAdd("VarCompanyBBEEMail", " ")
m_objdc.DokVarAdd("VarCompanyBBETelefon", " ")
m_objdc.DokVarAdd("VarCompanyBBETelefax", " ")
m_objdc.DokVarAdd("VarCompanyBBEZusatzVordruck", " ")
m_objdc.DokVarAdd("VarCompanyBBEZusatzInhalt", " ")
m_objdc.DokVarAdd("VarCompanyInternet", " ")
m_objdc.DokVarAdd("VarCompanyMWStNr", " ")
m_objdc.DokVarAdd("VarCompanyGerichtsstand", " ")
m_objdc.DokVarAdd("VarCompanyCantophone", " ")
m_objdc.DokVarAdd("VarCompanyHotlineInfoline", " ")
'Tempor<6F>re Variablen
m_objdc.DokVarAdd("VarTempGeschaeftNr", " ")
m_objdc.DokVarAdd("VarTempProduktebezeichnung", " ")
m_objdc.DokVarAdd("VarTempGeburtsGruendungsdatum", " ")
m_objdc.DokVarAdd("VarTempNationalitaetencode", " ")
m_objdc.DokVarAdd("VarTempMarktsegment", " ")
m_objdc.DokVarAdd("VarTempBranche", " ")
m_objdc.DokVarAdd("VarTempGesamtbetrag", " ")
m_objdc.DokVarAdd("VarTempBetrag1", " ")
m_objdc.DokVarAdd("VarTempBetrag2", " ")
m_objdc.DokVarAdd("VarTempWaehrung", " ")
m_objdc.DokVarAdd("VarTempZinssatz1", " ")
m_objdc.DokVarAdd("VarTempZinssatz2", " ")
m_objdc.DokVarAdd("VarTempObjekt", " ")
m_objdc.DokVarAdd("VarTempSchaetzungswert", " ")
m_objdc.DokVarAdd("VarTempKostenstelle", " ")
'Adressdaten
m_objdc.DokVarAdd("VarAdresse", " ")
m_objdc.DokVarAdd("VarVerteiler", " ")
m_objdc.DokVarAdd("VarAdressePostzustellung", " ")
m_objdc.DokVarAdd("VarAdresseAnrede", " ")
m_objdc.DokVarAdd("VarAdresseNameFirma", " ")
m_objdc.DokVarAdd("VarAdressezHd", " ")
m_objdc.DokVarAdd("VarAdresseAdresszeile1", " ")
m_objdc.DokVarAdd("VarAdresseAdresszeile2", " ")
m_objdc.DokVarAdd("VarAdressePLZ", " ")
m_objdc.DokVarAdd("VarAdresseOrt", " ")
m_objdc.DokVarAdd("VarPartnernr", " ")
'Formular Variablen
'm_objdc.DokVarAdd "VarFormularNr", " "
'm_objdc.DokVarAdd "VarFormularTitel", " "
'm_objdc.DokVarAdd "VarVersion", " "
' Sachbearbeiter
m_objdc.DokVarAdd("VarKennung", "")
m_objdc.DokVarAdd("VarKurzzeichen", " ")
m_objdc.DokVarAdd("VarName", " ")
m_objdc.DokVarAdd("VarVorname", " ")
m_objdc.DokVarAdd("VarTitel", " ")
m_objdc.DokVarAdd("VarBereich", " ")
m_objdc.DokVarAdd("VarOrganisationseinheit", " ")
m_objdc.DokVarAdd("VarAbkuerzung", " ")
m_objdc.DokVarAdd("VarBueroNr", " ")
m_objdc.DokVarAdd("VarRang", " ")
m_objdc.DokVarAdd("VarFunktion", " ")
m_objdc.DokVarAdd("VarDirektWahlTelefon", " ")
m_objdc.DokVarAdd("VarDirektWahlTelefax", " ")
m_objdc.DokVarAdd("VarEMail", " ")
m_objdc.DokVarAdd("VarBenutzerID", " ")
'Dokumentersteller
m_objdc.DokVarAdd("VarKennungDokSchreiber", " ")
m_objdc.DokVarAdd("VarKurzzeichenDokschreiber", " ")
m_objdc.DokVarAdd("VarNameDokSchreiber", " ")
m_objdc.DokVarAdd("VarVornameDokSchreiber", " ")
m_objdc.DokVarAdd("VarTitelDokSchreiber", " ")
m_objdc.DokVarAdd("VarBereichDokSchreiber", " ")
m_objdc.DokVarAdd("VarOrganisationseinheitDokSchreiber", " ")
m_objdc.DokVarAdd("VarAbkuerzungDokSchreiber", " ")
m_objdc.DokVarAdd("VarBueroNrDokSchreiber", " ")
m_objdc.DokVarAdd("VarRangDokSchreiber", " ")
m_objdc.DokVarAdd("VarFunktionDokSchreiber", " ")
m_objdc.DokVarAdd("VarDirektWahlTelefonDokSchreiber", " ")
m_objdc.DokVarAdd("VarDirektWahlTelefaxDokSchreiber", " ")
m_objdc.DokVarAdd("VarEMailDokschreiber", " ")
m_objdc.DokVarAdd("VarBenutzerIDWahlTelefaxDokSchreiber", " ")
'Linksunterzeichnenden
m_objdc.DokVarAdd("VarKennungLinks", " ")
m_objdc.DokVarAdd("VarKurzzeichenLinks", " ")
m_objdc.DokVarAdd("VarNameLinks", " ")
m_objdc.DokVarAdd("VarVornameLinks", " ")
m_objdc.DokVarAdd("VarTitelLinks", " ")
m_objdc.DokVarAdd("VarBereichLinks", " ")
m_objdc.DokVarAdd("VarOrganisationseinheitLinks", " ")
m_objdc.DokVarAdd("VarAbkuerzungLinks", " ")
m_objdc.DokVarAdd("VarBueroNrLinks", " ")
m_objdc.DokVarAdd("VarRangLinks", " ")
m_objdc.DokVarAdd("VarFunktionLinks", " ")
m_objdc.DokVarAdd("VarDirektWahlTelefonLinks", " ")
m_objdc.DokVarAdd("VarDirektWahlTelefaxLinks", " ")
m_objdc.DokVarAdd("VarEMailTelefaxLinks", " ")
m_objdc.DokVarAdd("VarBenutzerIDWahlTelefaxLinks", " ")
'Rechtsunterzeichnenden
m_objdc.DokVarAdd("VarKennungRechts", " ")
m_objdc.DokVarAdd("VarKurzzeichenRechts", " ")
m_objdc.DokVarAdd("VarNameRechts", " ")
m_objdc.DokVarAdd("VarVornameRechts", " ")
m_objdc.DokVarAdd("VarTitelRechts", " ")
m_objdc.DokVarAdd("VarBereichRechts", " ")
m_objdc.DokVarAdd("VarOrganisationseinheitRechts", " ")
m_objdc.DokVarAdd("VarAbkuerzungRechts", " ")
m_objdc.DokVarAdd("VarBueroNrRechts", " ")
m_objdc.DokVarAdd("VarRangRechts", " ")
m_objdc.DokVarAdd("VarFunktionRechts", " ")
m_objdc.DokVarAdd("VarDirektWahlTelefonRechts", " ")
m_objdc.DokVarAdd("VarDirektWahlTelefaxRechts", " ")
m_objdc.DokVarAdd("VarEMailTelefaxRechts", " ")
m_objdc.DokVarAdd("VarBenutzerIDWahlTelefaxRechts", " ")
Me.Errormessage = "4"
End Sub
Private Sub Create_IDVDokument(ByVal idvid As String)
Me.Errormessage = "5"
'DivFnkt.TraceLog("----- Vor IDV-Kill")
Cancel_IDVPortfeuille()
'DivFnkt.TraceLog("----- Nach IDV-Kill")
'DivFnkt.TraceLog("----- Word starten")
StartWord()
'DivFnkt.TraceLog("----- Ende Word starten")
'22.07.2003 Visible=False
objWord.Visible = False
'DivFnkt.TraceLog("----- Vor DC-Create Object")
m_objdc = CreateObject("DC.Application")
'DivFnkt.TraceLog("----- Nach DC-Create Object")
m_objdc.WindowState = dc.dcWindowState.dcInvisible
m_objdc.WindowState = 0
Thread.Sleep(10)
'DivFnkt.TraceLog("----- Vor Init IDV-Vars")
Init_IDV_Variablen()
'DivFnkt.TraceLog("----- Nach Init IDV-Vars")
m_objdc.WindowState = dc.dcWindowState.dcInvisible
'Call Get_IDV_Values()
'DivFnkt.TraceLog("----- Vor DC-Parameter")
Me.Errormessage = "6"
If Not Office_Vorlage.bIdv_nativ.Value = True Then
m_objdc.WindowState = 0
m_objdc.WordPlusDialog = dc.dcWordPlusDialogs.dcKein
m_objdc.DisableStandardMacros()
'DivFnkt.TraceLog("----- Nach DC-Parameter")
End If
Me.Errormessage = "7"
If Office_Vorlage.bIdv_nativ.Value = True Then
m_objdc.CreateDocument(dc.dcModus.dcMTBS, CType(Office_Vorlage.sIdv_id.Value, Integer))
StartWord()
docWord = objWord.ActiveDocument
objWord.Visible = False
m_objdc.Quit()
'BUD - 06.12.2006 - ComObject
System.Runtime.InteropServices.Marshal.ReleaseComObject(m_objdc)
m_objdc = Nothing
Me.Errormessage = "8"
'MsgBox("vor exit sub 01 ende funktion")
Exit Sub
Else
Me.Errormessage = "9"
m_objdc.CreateDocument(DC.dcModus.dcMTBS, CType(Office_Vorlage.sIdv_id.Value, Integer))
m_objdc.SaveDoc(Dokumentfilename)
'MsgBox("datei speichern")
Thread.Sleep(1000)
m_objdc.Quit()
'MsgBox("dc quit")
Thread.Sleep(1000)
'BUD - 06.12.2006 - ComObject
System.Runtime.InteropServices.Marshal.ReleaseComObject(m_objdc)
'MsgBox("obj zerst<73>ren")
m_objdc = Nothing
'DivFnkt.TraceLog("----- Nach IDV-Erstellung ( DC geschlossen) ")
' m_objdc = Nothing
' StartWord()
'22.07.2003 Visible=False
'DivFnkt.TraceLog("----- Word unsichtbar")
objWord.Visible = False
'DivFnkt.TraceLog("----- Word nicht sichtbar")
Try
docWord = objWord.ActiveDocument
Catch ex As Exception
Try
'DivFnkt.TraceLog("---------- " + ex.Message)
StartWord()
objWord.Documents.Open(Dokumentfilename)
docWord = objWord.ActiveDocument
'SHU
objWord.NormalTemplate.Saved = True
Catch
'DivFnkt.TraceLog("-------------- Dokument laden fehlgeschlagen")
End Try
End Try
'DivFnkt.TraceLog("----- Aktives Dokument zugewiesen")
'DivFnkt.TraceLog("----- Check_Dokname")
If docWord.Name <> DivFnkt.ExtractFilename(Dokumentfilename) Then
docWord.Close()
docWord = objWord.ActiveDocument
End If
'DivFnkt.TraceLog("----- Ende_Dokname")
End If
'BUD - 2006-12-06 --Nothing pr<70>fen
If Not m_objdc Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(m_objdc)
m_objdc = Nothing
'MsgBox("Auf Nothing pr<70>fen")
End If
'MsgBox("ende funktion")
Me.Errormessage = "10"
End Sub
Public Function IDV_makros_bearbeiten() As Boolean
Me.Errormessage = "11"
Dim idvmakros As New edokadb.clsMyDokumentDaten()
Dim makros As DataTable
Dim i As Long
idvmakros.cpMainConnectionProvider = conn
makros = idvmakros.Select_IDVMakros(Me.Dokumenttypnr)
Me.Errormessage = "12"
For i = 0 To makros.Rows.Count - 1
Try
If makros.Rows(i).Item("ist_in_dll") = True Then
'SetForegroundWindow(...)
Try
objWord.Activate()
Catch
Thread.Sleep(100)
objWord.Activate()
End Try
'System.Windows.Forms.Application.DoEvents()
idvdll = CreateObject("IDVMakros.Application")
Call idvdll.CallSub(objWord, makros.Rows(i).Item("makro"))
'System.Windows.Forms.Application.DoEvents()
objWord.Visible = True
Try
' objWord.Activate()
Catch
' Thread.Sleep(100)
' objWord.Activate()
End Try
Else
'System.Windows.Forms.Application.DoEvents()
objWord.Run(makros.Rows(i).Item("makro"))
'System.Windows.Forms.Application.DoEvents()
End If
Catch ex As Exception
MsgBox("Fehler beim Makro-Aufruf - Makro: " + makros.Rows(i).Item("makro") + vbCrLf + vbCrLf + ex.Message)
End Try
Next i
Me.Errormessage = "13"
End Function
#End Region
#Region "Word-Funktionen"
Private Function StartWord()
' StartWord_New_Instance()
' Exit Function
'Me.Errormessage = "14"
Try
DivFnkt.TraceLog("-----------Start Word GetObject")
objWord = GetObject(, "Word.application")
objWord.Application.Options.SaveInterval = 0
Me.WordnewInstance = False
Catch
Try
DivFnkt.TraceLog("-----------Start Word CreateObject")
objWord = CreateObject("Word.application")
objWord.Application.Options.SaveInterval = 0
Me.WordnewInstance = True
Catch ex As Exception
'MsgBox(ex.Message)
End Try
Finally
DivFnkt.TraceLog("-----------Start Word nicht sichtbar")
objWord.Visible = False
End Try
Try
objWord.Run("Autoexec")
Catch
End Try
'Me.Errormessage = "15"
End Function
Private Function StartWord_New_Instance()
Me.Errormessage = "16"
Try
objWord = CreateObject("Word.application")
Catch ex As Exception
MsgBox(ex.Message)
Exit Function
End Try
objWord.Visible = False
Me.Errormessage = "17"
End Function
Private Function StartIDVP()
Me.Errormessage = "18"
Try
m_objdc = GetObject("dc.application")
Catch
Try
m_objdc = CreateObject("dc.application")
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Try
Me.Errormessage = "19"
End Function
Private Sub Insert_Kopfzeile()
Me.Errormessage = "20"
On Error Resume Next
objWord.Selection.HomeKey(Unit:=Word.WdUnits.wdStory)
If objWord.ActiveWindow.View.SplitSpecial <> 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
Me.Errormessage = "21"
set_headerbookmark()
objWord.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekMainDocument
End Sub
Private Sub set_headerbookmark()
Me.Errormessage = "22"
Try
docWord.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 = WdBookmarkSortBy.wdSortByName
.ShowHidden = False
End With
End Try
Me.Errormessage = "23"
End Sub
Private Sub Fill_Dokument(ByVal AusParametrisierung As Boolean, Optional ByVal xdata As DataTable = Nothing)
Me.Errormessage = "24"
If Office_Vorlage.bKopfzeile_generieren.Value = True Then
Me.Errormessage = "25"
Insert_Kopfzeile()
End If
If AusParametrisierung Then
Me.Errormessage = "26"
get_dokumentdaten()
Dokumentwerte_Uebertragen(AusParametrisierung)
Else
Me.Errormessage = "27"
Dokumentdaten = xdata
Dokumentwerte_Uebertragen(AusParametrisierung)
End If
End Sub
Private Sub Dokumentwerte_Uebertragen(ByVal AusParametrisierung As Boolean)
Me.Errormessage = "28"
Dim i As Long
Dim pos As Long
Dim pos2 As Long
Dim Fieldlen As Long
For i = 0 To Dokumentdaten.Rows.Count - 1
'Beginn-Textmarke
If Dokumentdaten.Rows(i).Item("aktiv") = True Then
If Dokumentdaten.Rows(i).Item("beginntextmarke") Is System.DBNull.Value Then
Dokumentdaten.Rows(i).Item("beginntextmarke") = ""
End If
If Dokumentdaten.Rows(i).Item("endetextmarke") Is System.DBNull.Value Then
Dokumentdaten.Rows(i).Item("endetextmarke") = ""
End If
If Dokumentdaten.Rows(i).Item("feldname") Is System.DBNull.Value Then
Dokumentdaten.Rows(i).Item("feldname") = ""
End If
If Dokumentdaten.Rows(i).Item("beginntextmarke") = "TGEDKCursor" Or _
Dokumentdaten.Rows(i).Item("beginntextmarke") = "TGEDKCursorB" Or _
Dokumentdaten.Rows(i).Item("feldname") = "TGEDKCursorB" Or _
Dokumentdaten.Rows(i).Item("feldname") = "TGEDKCursor" Then
Cursor_Positionieren = True
Else
If Dokumentdaten.Rows(i).Item("beginntextmarke") <> "" And _
Dokumentdaten.Rows(i).Item("endetextmarke") = "" Then
Try
docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("beginntextmarke")).Select()
pos = docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("beginntextmarke")).Start
If AusParametrisierung Then
objWord.Selection.Text = Dokumentdaten.Rows(i).Item("testdaten")
Else
If Dokumentdaten.Rows(i).Item("used") = 1 Then
'If Dokumentdaten.Rows(i).Item("xvalue") <> "" Then
' If Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 19) = "TGEDKDirektTelefonB" Or _
' Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 19) = "TGEDKDirektTelefonZ" Then
' objWord.Visible = True
' objWord.Selection.Text = Dokumentdaten.Rows(i).Item("xvalue") + " "
' Else
objWord.Selection.Text = Dokumentdaten.Rows(i).Item("xvalue")
' End If
End If
End If
pos2 = objWord.Selection.End
If Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 19) = "XTGEDKDirektTelefonB" Or _
Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 23) = "XTGEDKVornameNameBetreue" Or _
Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 19) = "XTGEDKDirektTelefonZ" Then
objWord.Selection.MoveLeft(Unit:=Word.WdUnits.wdCharacter, Count:=1)
'hutter
If Me.CreateDoc Then objWord.Selection.TypeText(text:=" ")
objWord.Selection.SetRange(Start:=pos + 1, End:=pos2 + 1)
With docWord.Bookmarks
.Add(Range:=objWord.Selection.Range, Name:=Dokumentdaten.Rows(i).Item("beginntextmarke"))
.DefaultSorting = WdBookmarkSortBy.wdSortByName
.ShowHidden = False
End With
Else
If Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 22) = "XTGEDKDirektTelefonDokZ" Or _
Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 20) = "XTGEDKVornameNameDokZ" Then
objWord.Selection.Text = Dokumentdaten.Rows(i).Item("xvalue")
objWord.Selection.MoveLeft(Unit:=Word.WdUnits.wdCharacter, Count:=1)
objWord.Selection.TypeText(text:=" ")
objWord.Selection.SetRange(Start:=pos + 1, End:=pos2 + 1)
With docWord.Bookmarks
.Add(Range:=objWord.Selection.Range, Name:=Dokumentdaten.Rows(i).Item("beginntextmarke"))
.DefaultSorting = WdBookmarkSortBy.wdSortByName
.ShowHidden = False
End With
Else
objWord.Visible = True
objWord.Selection.SetRange(Start:=pos, End:=pos2)
With docWord.Bookmarks
.Add(Range:=objWord.Selection.Range, Name:=Dokumentdaten.Rows(i).Item("beginntextmarke"))
.DefaultSorting = WdBookmarkSortBy.wdSortByName
.ShowHidden = False
End With
End If
End If
objWord.Selection.MoveLeft(Unit:=Word.WdUnits.wdCharacter, Count:=1)
objWord.Selection.MoveLeft(Unit:=Word.WdUnits.wdCharacter, Count:=2, Extend:=Word.WdMovementType.wdExtend)
If objWord.Selection.Text = " " Then
objWord.Selection.MoveRight(Unit:=Word.WdUnits.wdCharacter, Count:=1)
objWord.Selection.MoveLeft(Unit:=Word.WdUnits.wdCharacter, Count:=1, Extend:=Word.WdMovementType.wdExtend)
objWord.Selection.Delete(Unit:=Word.WdUnits.wdCharacter, Count:=1)
End If
Catch
End Try
'EDEX Banklagernd
If Me.bldokument = True Then
If Dokumentdaten.Rows(i).Item("beginntextmarke") = "TGEDKBLGrundlage" Then
If Dokumentdaten.Rows(i).Item("xvalue") = "" Then
Try
docWord.Bookmarks.Item("TGEDKDELGrund1").Select()
objWord.Selection.Rows.Delete()
Catch
End Try
Try
docWord.Bookmarks.Item("TGEDKDELGrund2").Select()
objWord.Selection.Rows.Delete()
Catch
End Try
End If
End If
If Dokumentdaten.Rows(i).Item("beginntextmarke") = "TGEDKBLBemerkungen" Then
If Dokumentdaten.Rows(i).Item("xvalue") = "" Then
Try
docWord.Bookmarks.Item("TGEDKDELBemerkung1").Select()
objWord.Selection.Rows.Delete()
Catch
End Try
Try
docWord.Bookmarks.Item("TGEDKDELBemerkung2").Select()
objWord.Selection.Rows.Delete()
Catch
End Try
End If
End If
If Dokumentdaten.Rows(i).Item("beginntextmarke") = "TGEDKBLBeilagezurQuittung" Then
If Dokumentdaten.Rows(i).Item("xvalue") = "" Then
Try
docWord.Bookmarks.Item("TGEDKDELBeilage1").Select()
objWord.Selection.Rows.Delete()
Catch
End Try
Try
docWord.Bookmarks.Item("TGEDKDELBeilage2").Select()
objWord.Selection.Rows.Delete()
Catch
End Try
End If
End If
End If
End If
'Beginn- und Ende-Textmarke
If Dokumentdaten.Rows(i).Item("beginntextmarke") <> "" And _
Dokumentdaten.Rows(i).Item("endetextmarke") <> "" Then
Try
docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("beginntextmarke")).Select()
pos = docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("beginntextmarke")).Start
docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("endetextmarke")).Select()
pos2 = docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("endetextmarke")).Start
objWord.Selection.SetRange(Start:=pos, End:=pos2)
If AusParametrisierung Then
objWord.Selection.TypeText(text:=Dokumentdaten.Rows(i).Item("testdaten"))
Else
If Dokumentdaten.Rows(i).Item("used") = 1 Then
' If Dokumentdaten.Rows(i).Item("xvalue") <> "" Then
objWord.Selection.TypeText(text:=Dokumentdaten.Rows(i).Item("xvalue"))
End If
End If
With docWord.Bookmarks
.Add(Range:=objWord.Selection.Range, Name:=Dokumentdaten.Rows(i).Item("beginntextmarke"))
.DefaultSorting = WdBookmarkSortBy.wdSortByName
.ShowHidden = False
End With
Catch
End Try
End If
'Felder
If Dokumentdaten.Rows(i).Item("feldname") <> "" Then
Try
If docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).TextInput.Width <> 0 Then
Fieldlen = docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).TextInput.Width
docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).TextInput.Width = Fieldlen + 5
End If
If AusParametrisierung Then
docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).Result = convert_wordfelder(Dokumentdaten.Rows(i).Item("testdaten"))
Else
If Dokumentdaten.Rows(i).Item("used") = 1 Then
' If Dokumentdaten.Rows(i).Item("xvalue") <> "" Then
docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).Result = convert_wordfelder(Dokumentdaten.Rows(i).Item("xvalue"))
End If
End If
Catch
End Try
End If
End If
End If
Next
'EDEX Banklagernd
If Me.bldokument = True Then
If Me.BLUnterschrift1 <> "" Then
docWord.Bookmarks.Item("TGEDKBLUnterschrift1").Select()
pos = docWord.Bookmarks.Item("TGEDKBLUnterschrift1").Start
objWord.Selection.Text = Me.BLUnterschrift1
pos2 = objWord.Selection.End
With docWord.Bookmarks
.Add(Range:=objWord.Selection.Range, Name:="TGEDKBLUnterschrift1")
.DefaultSorting = WdBookmarkSortBy.wdSortByName
.ShowHidden = False
End With
End If
If Me.BLUnterschrift2 <> "" Then
docWord.Bookmarks.Item("TGEDKBLUnterschrift2").Select()
pos = docWord.Bookmarks.Item("TGEDKBLUnterschrift2").Start
objWord.Selection.Text = Me.BLUnterschrift2
pos2 = objWord.Selection.End
With docWord.Bookmarks
.Add(Range:=objWord.Selection.Range, Name:="TGEDKBLUnterschrift2")
.DefaultSorting = WdBookmarkSortBy.wdSortByName
.ShowHidden = False
End With
End If
Try
docWord.Bookmarks.Item("TGEDKBLQuittungtext").Select()
objWord.Selection.Text = Me.BLQuittungstext
Catch
End Try
If bldelquittungkube = True Then
docWord.Bookmarks.Item("TGEDKQuittungKubeB").Select()
pos = docWord.Bookmarks.Item("TGEDKQuittungKubeB").Start
docWord.Bookmarks.Item("TGEDKQuittungKubeE").Select()
pos2 = docWord.Bookmarks.Item("TGEDKQuittungKubeE").Start
objWord.Selection.SetRange(Start:=pos, End:=pos2)
objWord.Selection.TypeText(" ")
End If
End If
Me.Errormessage = "29"
End Sub
Private Sub FeldMakros()
Me.Errormessage = "30"
Dim i As Integer
For i = 0 To Dokumentdaten.Rows.Count - 1
If Dokumentdaten.Rows(i).Item("feldname") <> "" Then
If Dokumentdaten.Rows(i).Item("einstiegsmakro") = True Then
objWord.Run(docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).EntryMacro)
End If
If Dokumentdaten.Rows(i).Item("ausstiegsmakro") = True Then
objWord.Run(docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).ExitMacro)
End If
End If
Next
Me.Errormessage = "31"
End Sub
#End Region
#Region "Excel-Funktionen"
Private Function StartExcel()
'Me.Errormessage = "32"
Try
objExcel = CreateObject("Excel.application")
Catch ex As Exception
'MsgBox(ex.Message)
Exit Function
End Try
objExcel.Visible = False
'Me.Errormessage = "33"
End Function
#End Region
#Region "Datenhandling"
Private Sub get_dokumentdaten()
Me.Errormessage = "34"
dokudata.cpMainConnectionProvider = conn
Dokumentdaten = dokudata.SelectTestdata(Me.Dokumenttypnr)
dokudata.Dispose()
Me.Errormessage = "35"
End Sub
#End Region
#Region "Barcode"
Dim Textboxes(100) As String
Dim Textboxesi As Integer
Private Sub Generate_Barcodes()
If Me.Excel_Dokument Then
insert_Barcode_Excel()
Exit Sub
End If
Me.Errormessage = "36"
Me.ProgressBar.Bar1a.Value = 71
Me.ProgressBar.Info.Text = "Bestehende Barcodes l<>schen"
delete_Textfelder()
Me.ProgressBar.Bar1a.Value = 81
Me.ProgressBar.Info.Text = "Positionen f<>r Barcodes ermitteln"
Insert_TextFelder()
Me.ProgressBar.Bar1a.Value = 91
Me.ProgressBar.Info.Text = "Barcodes erstellen"
ins_Barcode()
Me.ProgressBar.Bar1a.Value = 100
Me.ProgressBar.Info.Text = "Dokumentgenerierung abgeschlossen"
Me.Errormessage = "37"
End Sub
Private Sub delete_Textfelder()
Me.Errormessage = "38"
Dim xname As String
Dim i As Integer
Dim i1 As Integer
Dim pages As Long
Dim Prop As Object
objWord.Selection.HomeKey(Unit:=Word.WdUnits.wdStory)
For Each Prop In objWord.ActiveDocument.BuiltInDocumentProperties
If UCase(Prop.Name) = "NUMBER OF PAGES" Then
pages = Prop.value
End If
Next
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()
While objWord.Selection.HeaderFooter.Shapes.Count > 0
objWord.Selection.HeaderFooter.Shapes.Item(1).Delete()
End While
' On Error GoTo eh
' ' Resume Next
' For i1 = 1 To objWord.Selection.HeaderFooter.Shapes.Count
' objWord.Selection.HeaderFooter.Shapes.Item(i1).Delete()
' Next i1
' On Error GoTo 0
objWord.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekMainDocument
Next i
Me.Errormessage = "39"
Exit Sub
eh:
Me.Errormessage = "40"
'MsgBox(Err.Description)
Resume Next
End Sub
Private Sub Insert_TextFelder()
Me.Errormessage = "41"
Dim xname As String
Dim i As Integer
Dim pages As Long
Dim prop As Object
For Each prop In objWord.ActiveDocument.BuiltInDocumentProperties
If UCase(prop.Name) = "NUMBER OF PAGES" Then
pages = prop.value
End If
Next
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 = WdSeekView.wdSeekMainDocument
Next i
Me.Errormessage = "42"
End Sub
Private Sub ins_Barcode()
Me.Errormessage = "43"
Dim xname As String
Dim i As Integer
Dim pages As Long
Dim prop As Object
For Each prop In objWord.ActiveDocument.BuiltInDocumentProperties
If UCase(prop.Name) = "NUMBER OF PAGES" Then
pages = prop.value
End If
Next
Me.Errormessage = "44"
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 = WdSeekView.wdSeekMainDocument
Next i
Me.Errormessage = "45"
End Sub
Private Sub HeaderFooterAnzeigen()
Me.Errormessage = "46"
If objWord.ActiveWindow.View.SplitSpecial <> WdSpecialPane.wdPaneNone Then
objWord.ActiveWindow.Panes.Item(2).Close()
End If
If objWord.ActiveWindow.ActivePane.View.Type = WdViewType.wdNormalView Or objWord.ActiveWindow.ActivePane.View.Type = WdViewType.wdOutlineView Then
objWord.ActiveWindow.ActivePane.View.Type = WdViewType.wdPrintView
End If
objWord.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekCurrentPageHeader
If objWord.Selection.HeaderFooter.IsHeader = True Then
objWord.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekCurrentPageFooter
Else
objWord.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekCurrentPageHeader
End If
Me.Errormessage = "47"
End Sub
Private Sub insert_Textfield()
Me.Errormessage = "48"
Dim Public_barcodeleft
Dim Public_barcodetop
Dim Public_barcodewidth#
Dim Public_barcodeheight
Try
Public_barcodeleft = Office_Vorlage.iBcpl.Value
Public_barcodetop = Office_Vorlage.iBcpt.Value
Public_barcodewidth = Office_Vorlage.iBcw.Value
Public_barcodeheight = Office_Vorlage.iBch.Value
HeaderFooterAnzeigen()
objWord.Selection.HeaderFooter.Shapes.AddTextbox(1, Public_barcodeleft, Public_barcodetop, _
Public_barcodewidth#, Public_barcodeheight).Select()
' objWord.Selection.ShapeRange.TextFrame.TextRange.Select
objWord.Selection.ShapeRange.Line.Visible = Office.MsoTriState.msoFalse
'objWord.Selection.ShapeRange.Line.Visible = Microsoft.Office.Core.MsoTriState.msoFalse 'RS:2006-08-22
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
'System.Windows.Forms.Application.DoEvents()
Exit Sub
Catch ex As Exception
'MsgBox(ex.Message)
End Try
Me.Errormessage = "49"
End Sub
Private Sub insert_Barcode_Excel()
Me.Errormessage = "50"
Dim i As Integer
Dim i1 As Integer
Dim s As String
Dim na As String
Dim xx As Integer
Me.ProgressBar.Bar1a.Value = 81
Me.ProgressBar.Info.Text = "Barcodes generieren"
'Rel 3.21 BUD/SHU
Dim id As String
If Me.Dokumentidbr <> "" Then id = Me.Dokumentidbr Else id = Me.DokumentID
s = Bar25I(Microsoft.VisualBasic.Right(Right(id, Len(id) - 6), 16))
For i = 1 To docExcel.Sheets.Count
docExcel.Sheets(i).activate()
For i1 = 1 To docExcel.Names.Count
Try
na = docExcel.Names.Item(i1).NameLocal
If Left(na, 7) = "TGEDKBC" Then
objExcel.Range(objExcel.Names.Item(na).NameLocal).Select()
objExcel.ActiveCell.FormulaR1C1 = s
With objExcel.Selection.Characters.Font
.Name = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("barcode_font")
'.Size = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("bcfont_groesse")
End With
'objExcel.Selection.HorizontalAlignment = Excel.XlHAlign.xlHAlignRight
End If
Dim ZEICHEN As String = ""
If Left(na, 7) = "TGEDKAR" Then
objExcel.Range(objExcel.Names.Item(na).NameLocal).Select()
'edex Banklagernd
Select Case DokumenTtyp.iPhysisches_archiv.Value
Case 0
Case 1
ZEICHEN = "U"
Case 2
ZEICHEN = "F"
End Select
If Me.SaveBLDossier = True Then
ZEICHEN = ZEICHEN + "/B"
End If
objExcel.ActiveCell.FormulaR1C1 = convert_excel(ZEICHEN)
'If DokumenTtyp.iPhysisches_archiv.Value = 2 Then
' ZEICHEN = "F"
' 'objExcel.ActiveCell.FormulaR1C1 = convert_excel("F")
'Else
' ZEICHEN = "U"
' 'objExcel.ActiveCell.FormulaR1C1 = convert_excel("U")
'End If
End If
Catch ex As Exception
End Try
Next
Next
Me.Errormessage = "51"
End Sub
Private Sub insert_Barcode(ByVal x As Integer)
Dim Form
Dim strsel As String
Dim strresult
Dim s As String
' Selection.ShapeRange.Select
Me.Errormessage = "52"
If DokumenTtyp.bZu_retournieren.Value = True Or Me.Dokumentidbr <> "" Or Me.SaveBLDossier = True Then
Try
Form = objWord.Selection.HeaderFooter.Shapes.Item(Textboxes(Textboxesi))
Form.Select()
Form = objWord.Selection.HeaderFooter.Shapes.Item(Textboxes(Textboxesi))
Form.Select()
If Office_Vorlage.bBchorizontal.Value = False Then
objWord.ActiveDocument.Tables.Add(Range:=objWord.Selection.Range, NumRows:=1, NumColumns:=1)
With objWord.Selection.Tables.Item(1)
.Borders.Item(WdBorderType.wdBorderLeft).LineStyle = WdLineStyle.wdLineStyleNone
.Borders.Item(WdBorderType.wdBorderRight).LineStyle = WdLineStyle.wdLineStyleNone
.Borders.Item(WdBorderType.wdBorderTop).LineStyle = WdLineStyle.wdLineStyleNone
.Borders.Item(WdBorderType.wdBorderBottom).LineStyle = WdLineStyle.wdLineStyleNone
.Borders.Item(WdBorderType.wdBorderDiagonalDown).LineStyle = WdLineStyle.wdLineStyleNone
.Borders.Item(WdBorderType.wdBorderDiagonalUp).LineStyle = 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
'gaga'
Dim id As String
If Me.Dokumentidbr <> "" Then id = Me.Dokumentidbr Else id = Me.DokumentID
s = Bar25I(Microsoft.VisualBasic.Right(Right(id, Len(id) - 6), 16))
' s = Bar25I(Microsoft.VisualBasic.Right(Right(m_DokumentID, Len(m_DokumentID) - 6), 16))
's = Bar25I("0012002123456789")
objWord.Selection.TypeText(text:=s)
objWord.Selection.HomeKey(Unit:=Word.WdUnits.wdLine, Extend:=Word.WdMovementType.wdExtend)
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.ParagraphFormat.Alignment = WdParagraphAlignment.wdAlignParagraphRight
objWord.Selection.EndKey(Unit:=Word.WdUnits.wdLine)
objWord.Selection.Font.Name = "Arial"
objWord.Selection.Font.Size = 8
Dim Zeichen As String
If Me.Dokumentidbr <> "" Then
Dim dok As New edokadb.clsDokument()
dok.cpMainConnectionProvider = conn
dok.sDokumentid = New SqlString(CType(Me.Dokumentidbr, String))
dok.SelectOne()
Dim doktypbr As New edokadb.clsDokumenttyp()
doktypbr.cpMainConnectionProvider = conn
doktypbr.iDokumenttypnr = New SqlInt32(CType(dok.iDokumenttypnr.Value, Int32))
doktypbr.SelectOne()
Select Case doktypbr.iPhysisches_archiv.Value
Case 0
Case 1
Zeichen = " U"
'objWord.Selection.TypeText(" U")
Case 2
Zeichen = " F"
'objWord.Selection.TypeText(" F")
End Select
dok.Dispose()
doktypbr.Dispose()
Else
Select Case DokumenTtyp.iPhysisches_archiv.Value
Case 0
Case 1
Zeichen = " U"
'objWord.Selection.TypeText(" U")
Case 2
Zeichen = " F"
'objWord.Selection.TypeText(" F")
End Select
End If
If Me.SaveBLDossier = True Then
Zeichen = Zeichen + "/B"
End If
objWord.Selection.TypeText(Zeichen)
Form = Nothing
Catch ex As Exception
Me.Errormessage = "53"
End Try
End If
Me.Errormessage = "54"
End Sub
#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
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
Me.Errormessage = "208"
' 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
Me.Errormessage = "209"
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
Me.Errormessage = "210"
' 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
Me.Errormessage = "211"
End Function
#End Region
#Region "<22>ffentliche Methoden"
#Region "Word"
Public Sub Close_And_Destroy()
If Me.Excel_Dokument = True Then
Me.Close_And_Destroy_excel()
Exit Sub
End If
Try
docWord.Close(False)
docWord = Nothing
Catch
End Try
Try
objWord.Quit(False)
objWord = Nothing
Catch
End Try
End Sub
Public Sub Close_And_Destroy_excel()
Try
docExcel.Close(False)
docExcel = Nothing
Catch
End Try
Try
objExcel.Quit()
objExcel = Nothing
Catch
End Try
End Sub
Public Function Create_Dokument_Before_Fill(ByVal DokTypeNr As Long, ByVal xdata As DataTable, ByVal fname As String, Optional ByVal sKopyDokID As String = "") As Boolean
Me.Errormessage = "55"
'Office-Vorlage auslesen
Me.inEditMode = False
Me.Excel_Dokument = False
Me.Dokumenttypnr = DokTypeNr
m_sKopyDokID = sKopyDokID
DokumenTtyp.cpMainConnectionProvider = conn
DokumenTtyp.iDokumenttypnr = New SqlInt32(CType(Me.Dokumenttypnr, Int32))
DokumenTtyp.SelectOne()
Me.ProgressBar.Bar1a.Value = 26
Me.ProgressBar.Info.Text = "Office-Dokument erstellen"
Office_Vorlage.cpMainConnectionProvider = conn
Office_Vorlage.iOffice_vorlagenr = DokumenTtyp.iOffice_vorlagenr
Office_Vorlage.SelectOne()
If Office_Vorlage.iAnwendungnr.Value = 2 Then
If Not Create_Excel_Before_Fill(DokTypeNr, xdata, fname, sKopyDokID) Then
Return False
Else
Return True
End If
Exit Function
End If
DivFnkt.TraceLog("--- Vor Tempor<6F>re Datei erstellen")
'Tempor<6F>r-Datei
Dokument_Temp = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente")
CheckDokumentname = Dokument_Temp + Office_Vorlage.sPrefix_dokumentname.Value + ".doc"
Dokument_Temp = Dokument_Temp + Office_Vorlage.sPrefix_dokumentname.Value + ".doc"
DivFnkt.TraceLog("--- Ende Tempor<6F>re Datei erstellen")
Me.ProgressBar.Bar1a.Value = 31
'Nativ-Dokumentvorlage
Me.Errormessage = "56"
If Not Office_Vorlage.bIdv_vorlage.Value = True Then
Dim LoopCnt As Integer = 0
Dim DokumentGeladen As Boolean = False
While DokumentGeladen = False And LoopCnt < 4
Try
LoopCnt = LoopCnt + 1
'Rel 3.5 / BUD / 13.01.2005
If sKopyDokID = "" Then
Dim x As New FrmDomainOfficeVorlageDatei()
Dokument_To_Create = x.Get_From_DB(Me.Office_Vorlage.iOffice_vorlagenr.Value, Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente"))
x.Dispose()
Else
Dim objDocMgmt As New DocMgmt()
Dokument_To_Create = fname
objDocMgmt.Get_From_DB(sKopyDokID, Dokument_To_Create)
objDocMgmt = Nothing
End If
FileSystem.Rename(Dokument_To_Create, fname)
StartWord()
Dokumentfilename = fname
objWord.Documents.Open(fname)
docWord = objWord.ActiveDocument
objWord.NormalTemplate.Saved = True
DokumentGeladen = True
Catch
DokumentGeladen = False
Try
Close_And_Destroy()
Catch
End Try
Try
File.Delete(fname)
Catch
End Try
Catch
End Try
End While
Me.Errormessage = "57"
If DokumentGeladen = False Then
MyMsg.show_standardmessage(137, MsgBoxStyle.Exclamation)
Me.ProgressBar.Visible = False
Try
objWord.Visible = True
Catch
StartWord()
objWord.Visible = True
End Try
Try
Catch
objWord.WindowState = WdWindowState.wdWindowStateMinimize
End Try
Try
'Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Maximize)
Catch
End Try
Return False
End If
Me.Errormessage = "58"
Else
Me.Errormessage = "59"
Dokumentfilename = fname
If Not OhneIDV Then
DivFnkt.TraceLog("--- Vor IDV-Erstellung")
Create_IDVDokument(Office_Vorlage.sIdv_id.Value)
DivFnkt.TraceLog("--- Nach IDV-Erstellung")
Me.Errormessage = "60"
Else
Me.Errormessage = "61"
Dokument_To_Create = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_word_vorlagen") + Office_Vorlage.sIdv_id.Value + ".doc"
StartWord()
Dokumentfilename = fname
objWord.Documents.Add(Template:=Dokument_To_Create)
objWord.ActiveDocument.SaveAs(filename:=fname)
docWord = objWord.ActiveDocument
Me.Errormessage = "62"
End If
End If
DivFnkt.TraceLog("----- Ende Dokumenterstellung IDV/Word")
Me.Errormessage = "63"
Me.ProgressBar.Bar1a.Value = 36
Me.ProgressBar.Bar1a.Refresh()
IsProtected = False
If docWord.ProtectionType <> WdProtectionType.wdNoProtection Then
docWord.Unprotect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_wordvorlagen"))
IsProtected = True
End If
'Dokument ggf. entsperren, Daten <20>bertragen, Dokument ggf. sch<63>tzen
' If Office_Vorlage.bDokument_geschuetzt.Value = True Then
' docWord.Unprotect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_wordvorlagen"))
' End If
objWord.Visible = False
Me.ProgressBar.Bar1a.Value = 41
Me.ProgressBar.Info.Text = "Vorhandene Werte aus dem Dokument auslesen"
Word_Werte_Auslesen(xdata)
Me.ProgressBar.Bar1a.Value = 51
Me.ProgressBar.Info.Text = "Neue und Bestehende Werte zusammenstellen"
Me.Errormessage = "64"
Return True
End Function
Public Sub Open_Document(ByVal fname As String, ByVal xdata As DataTable, ByVal doktypeNr As Long)
Me.Errormessage = "65"
Me.Dokumenttypnr = doktypeNr
Me.inEditMode = True
DokumenTtyp.cpMainConnectionProvider = conn
DokumenTtyp.iDokumenttypnr = New SqlInt32(CType(Me.Dokumenttypnr, Int32))
DokumenTtyp.SelectOne()
Me.ProgressBar.Bar1a.Value = 41
Me.ProgressBar.Info.Text = "Office-Dokument <20>ffnen"
Office_Vorlage.cpMainConnectionProvider = conn
Office_Vorlage.iOffice_vorlagenr = DokumenTtyp.iOffice_vorlagenr
Office_Vorlage.SelectOne()
If Office_Vorlage.iAnwendungnr.Value = 2 Then
Open_Excel(fname, xdata, doktypeNr)
Exit Sub
End If
Me.Errormessage = "66"
StartWord()
Dokumentfilename = fname
objWord.Documents.Open(fname)
docWord = objWord.ActiveDocument
objWord.Visible = False
'SHU
objWord.NormalTemplate.Saved = True
Me.ProgressBar.Bar1a.Value = 41
Me.ProgressBar.Info.Text = "Vorhandene Werte aus dem Dokument auslesen"
If docWord.ProtectionType <> WdProtectionType.wdNoProtection Then
docWord.Unprotect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_wordvorlagen"))
IsProtected = True
End If
Word_Werte_Auslesen(xdata)
Me.ProgressBar.Bar1a.Value = 51
Me.ProgressBar.Info.Text = "Neue und Bestehende Werte zusammenstellen"
Me.Errormessage = "67"
End Sub
Public Sub Dokument_Vervollstaendigen(ByVal xdata As DataTable)
Me.Errormessage = "68"
If Me.Excel_Dokument = True Then
Excel_Vervollstaendigen(xdata)
Exit Sub
End If
Me.ProgressBar.Bar1a.Value = 61
Me.ProgressBar.Info.Text = "Dokumentwerte <20>bertragen"
If docWord.ProtectionType <> WdProtectionType.wdNoProtection Then
docWord.Unprotect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_wordvorlagen"))
IsProtected = True
End If
DivFnkt.TraceLog("Word Visible = false")
objWord.Visible = False
DivFnkt.TraceLog("Windowstate")
objWord.WindowState = WdWindowState.wdWindowStateMinimize
DivFnkt.TraceLog("Doevents")
'System.Windows.Forms.Application.DoEvents()
DivFnkt.TraceLog("FillDok Start")
Fill_Dokument(False, xdata)
DivFnkt.TraceLog("FillDok")
Me.Errormessage = "69"
'EDEX-Banklagernd
If DokumenTtyp.bZu_retournieren.Value = True Or DokumenTtyp.iDoktypbedingteretournierung.Value > 0 Or Me.SaveBLDossier = True Then
DivFnkt.TraceLog("Barcodes Start")
Generate_Barcodes()
DivFnkt.TraceLog("Barcodes Ende")
Else
Try
DivFnkt.TraceLog("Active Win start")
objWord.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekMainDocument
DivFnkt.TraceLog("Active Win ende")
Catch
End Try
End If
DivFnkt.TraceLog("Screenupdating true ")
objWord.ScreenUpdating = True
DivFnkt.TraceLog("Active Win end")
Me.ProgressBar.Hide()
DivFnkt.TraceLog("Progress Close")
Me.Errormessage = "70"
If IsProtected Then
Try
docWord.Protect(Type:=WdProtectionType.wdAllowOnlyFormFields, noreset:=True, password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_wordvorlagen"))
Catch
End Try
End If
DivFnkt.TraceLog("Ende sch<63>tzen")
Dim A As Integer
A = 0
Me.Errormessage = "71"
While A < 2
Try
objWord.Visible = True
DivFnkt.TraceLog("Word Activate")
objWord.Activate()
DivFnkt.TraceLog("Word Activate Ende")
A = 2
Catch
Try
Thread.Sleep(500)
DivFnkt.TraceLog("Word Activate")
objWord.Visible = True
objWord.Activate()
DivFnkt.TraceLog("Word Activate ENde")
A = 2
Catch
If MyMsg.Show_MessageYesNo(107) = MsgBoxResult.Yes Then
A = 1
Else
docWord.Close(False)
docWord = Nothing
objWord = Nothing
A = 3
Throw New Exception(MyTxt.gettext(111))
End If
End Try
End Try
End While
Me.Errormessage = "72"
objWord.WindowState = WdWindowState.wdWindowStateMaximize
FeldMakros()
If objWord.ActiveWindow.View.SplitSpecial = WdSpecialPane.wdPaneNone Then
objWord.ActiveWindow.ActivePane.View.Type = WdViewType.wdPrintView
Else
objWord.ActiveWindow.View.Type = WdViewType.wdPrintView
End If
objWord.Visible = True
Try
' Rel 4.0 Fensterhandling Problem
' Handle verweis auf Prozess EDOKA...
Dim p As Process
Dim Ret As Int32
Dim hWndMain As IntPtr
Dim MyProcesses() As Process = _
Process.GetProcessesByName( _
Process.GetCurrentProcess().ProcessName)
For Each p In MyProcesses
If (p.Id = Process.GetCurrentProcess().Id) Then
Globals.Apphandle = p.MainWindowHandle()
End If
Next
Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Minimze)
Catch
End Try
'Rel 3.5 / BUD / 13.01.2005 (IF / END IF)
If m_sKopyDokID = "" Then
If Me.CreateDoc = True Then IDV_makros_bearbeiten()
End If
If Me.CreateDoc Then
Dim dn As String = objWord.ActiveDocument.FullName
docWord.Save()
docWord.Close()
objWord.Documents.Open(dn)
'SHU
objWord.NormalTemplate.Saved = True
docWord = objWord.ActiveDocument
'EDEX Banklagernd
If Me.bldokument = True Then
If Me.BLDel2Page Then
Try
docWord.Bookmarks.Item("TGEDKZweiteSeite").Select()
objWord.Selection.Delete()
Catch ex As Exception
MsgBox(ex.Message)
End Try
docWord.Save()
docWord.Close()
objWord.Documents.Open(dn)
'SHU
objWord.NormalTemplate.Saved = True
docWord = objWord.ActiveDocument
End If
End If
End If
docWord.Saved = False
Me.Errormessage = "73"
If Cursor_Positionieren Then
Try
docWord.Bookmarks.Item("TGEDKCursor").Select()
Catch
Try
docWord.Bookmarks.Item("TGEDKCursorB").Select()
Catch
End Try
End Try
End If
Me.Dokument_Saved = False
If objWord.ActiveWindow.View.SplitSpecial = WdSpecialPane.wdPaneNone Then
objWord.ActiveWindow.ActivePane.View.Type = WdViewType.wdPrintView
Else
objWord.ActiveWindow.View.Type = WdViewType.wdPrintView
End If
Me.Errormessage = "74"
If IsNothing(objSpooler) = False Then
If Not Me.bldokument Or objSpooler.NoEdit = 2 Then
objWord.Visible = False
objWord.Visible = True
Else
objWord.Visible = False
End If
Else
If Not Me.bldokument Then
objWord.Visible = False
objWord.Visible = True
Else
objWord.Visible = False
End If
End If
Office_Vorlage.Dispose()
DokumenTtyp.Dispose()
'EDEX-Banklagernd
If Me.bldokument Then
' Me.Save_DateTime = Me.Save_DateTime.AddSeconds(-3)
Me.docWord.Save()
Me.docWord.Close(SaveChanges:=True)
'rel 372
If objWord.Documents.Count = 0 Then
objWord.Quit(SaveChanges:=False)
Try
objWord = Nothing
Catch ex As Exception
End Try
End If
Finishing()
'rel 372 EDOKA nach vorne bringen
'Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Maximize)
Thread.CurrentThread.Sleep(100)
Exit Sub
End If
'rel 4.0 handle DirektErstellung <20>ber Avaloq-Schnittstelle
If IsNothing(objSpooler) = False Then
If objSpooler.NoEdit = 2 Then
Me.docWord.Close(SaveChanges:=True)
objWord.Quit()
WordWatch.Stopp()
Finishing()
'rel 372 EDOKA nach vorne bringen
'Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Maximize)
Thread.CurrentThread.Sleep(100)
Exit Sub
End If
End If
Control_Word()
End Sub
Public Sub Word_Werte_Auslesen(ByVal xdata As DataTable)
Me.Errormessage = "75"
Dim i As Integer
Dim pos, pos2 As Integer
For i = 0 To xdata.Rows.Count - 1
xdata.Rows(i).Item("used") = 0
If xdata.Rows(i).Item("beginntextmarke") <> "" And xdata.Rows(i).Item("endetextmarke") = "" Then
Try
docWord.Bookmarks.Item(xdata.Rows(i).Item("beginntextmarke")).Select()
xdata.Rows(i).Item("oldvalue") = convert(objWord.Selection.Text)
xdata.Rows(i).Item("used") = 1
Catch
End Try
If xdata.Rows(i).Item("beginntextmarke") = "TGEDKCompanyBBEB99" Then xdata.Rows(i).Item("used") = 1
End If
If xdata.Rows(i).Item("beginntextmarke") <> "" And xdata.Rows(i).Item("endetextmarke") <> "" Then
Try
docWord.Bookmarks.Item(xdata.Rows(i).Item("beginntextmarke")).Select()
pos = objWord.Selection.Start
docWord.Bookmarks.Item(xdata.Rows(i).Item("endetextmarke")).Select()
pos2 = objWord.Selection.Start
objWord.Selection.SetRange(Start:=pos, End:=pos2)
xdata.Rows(i).Item("oldvalue") = convert(objWord.Selection.Text)
xdata.Rows(i).Item("used") = 1
Catch
End Try
End If
Try
If xdata.Rows(i).Item("feldname") <> "" Then
Try
xdata.Rows(i).Item("oldvalue") = convert(docWord.FormFields.Item(xdata.Rows(i).Item("feldname")).Result)
xdata.Rows(i).Item("used") = 1
Catch
End Try
End If
Catch
End Try
Next
Me.Errormessage = "76"
End Sub
Public Sub Create_Dokument(ByVal DokTypeNr As Long, ByVal ShowReport As Boolean)
Me.Errormessage = "77"
'Office-Vorlage auslesen
Me.inEditMode = False
Me.Dokumenttypnr = DokTypeNr
DokumenTtyp.cpMainConnectionProvider = conn
DokumenTtyp.iDokumenttypnr = New SqlInt32(CType(Me.Dokumenttypnr, Int32))
DokumenTtyp.SelectOne()
Office_Vorlage.cpMainConnectionProvider = conn
Office_Vorlage.iOffice_vorlagenr = DokumenTtyp.iOffice_vorlagenr
Office_Vorlage.SelectOne()
'Tempor<6F>r-Datei
Dokument_Temp = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente")
Dokument_Temp = Dokument_Temp + Office_Vorlage.sPrefix_dokumentname.Value + Change_Docname(Now) + ".doc"
Dokumentfilename = Dokument_Temp
'Nativ-Dokumentvorlage
If Not Office_Vorlage.bIdv_vorlage.Value = True Then
Dokument_To_Create = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_word_vorlagen") + Office_Vorlage.sOffice_vorlage.Value
StartWord()
objWord.Documents.Add(Template:=Dokument_To_Create)
objWord.ActiveDocument.SaveAs(filename:=Dokumentfilename)
docWord = objWord.ActiveDocument
Else
Create_IDVDokument(Office_Vorlage.sIdv_id.Value)
End If
Me.Errormessage = "78"
IsProtected = False
If docWord.ProtectionType <> WdProtectionType.wdNoProtection Then
docWord.Unprotect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_wordvorlagen"))
IsProtected = True
End If
'Dokument ggf. entsperren, Daten <20>bertragen, Dokument ggf. sch<63>tzen
' If Office_Vorlage.bDokument_geschuetzt.Value = True Then
' docWord.Unprotect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_wordvorlagen"))
' End If
Me.Errormessage = "79"
Fill_Dokument(True)
'EDEX Banklagernd
If DokumenTtyp.bZu_retournieren.Value = True Or DokumenTtyp.iDoktypbedingteretournierung.Value > 0 Or Me.SaveBLDossier = True Then
Me.Errormessage = "80"
Generate_Barcodes()
Else
Try
objWord.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekMainDocument
Catch
End Try
End If
' Me.ProgressBar.Close()
If IsProtected Then
Try
docWord.Protect(Type:=WdProtectionType.wdAllowOnlyFormFields, noreset:=True, password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_wordvorlagen"))
Catch
End Try
End If
Me.Errormessage = "81"
FeldMakros()
If objWord.ActiveWindow.View.SplitSpecial = WdSpecialPane.wdPaneNone Then
objWord.ActiveWindow.ActivePane.View.Type = WdViewType.wdPrintView
Else
objWord.ActiveWindow.View.Type = WdViewType.wdPrintView
End If
Me.Errormessage = "82"
objWord.Visible = True
IDV_makros_bearbeiten()
If Cursor_Positionieren Then
Try
docWord.Bookmarks.Item("TGEDKCursor").Select()
docWord.Bookmarks.Item("TGEDKCursorB").Select()
Catch
End Try
End If
Me.Errormessage = "83"
objWord.Visible = True
Office_Vorlage.Dispose()
DokumenTtyp.Dispose()
If Not ShowReport Then
docWord = Nothing
objWord = Nothing
Else
Get_Docvars(DokTypeNr)
End If
End Sub
Public Sub ShowDoc(ByVal s As String)
Me.Errormessage = "84"
If UCase(Right(s, 3)) = "XLS" Then
StartExcel()
objExcel.Workbooks.Open(s)
objExcel.Visible = True
Me.Excel_Dokument = True
End If
If UCase(Right(s, 3)) = "DOC" Then
StartWord()
Me.Excel_Dokument = False
objWord.Run("Autoexec")
objWord.Documents.Open(s)
docWord = objWord.ActiveDocument
'SHU
objWord.NormalTemplate.Saved = True
Try
docWord.Application.Visible = True
docWord.Activate()
Catch
Thread.Sleep(100)
docWord.Application.Visible = True
docWord.Activate()
End Try
insert_wordart()
objWord.Visible = True
Try
objWord.Activate()
Catch
Thread.Sleep(100)
objWord.Activate()
End Try
objWord.NormalTemplate.Saved = True
End If
Me.DokumentName = DivFnkt.ExtractFilename(s)
Control_Word_readonly()
Me.Errormessage = "85"
End Sub
Public Function insert_wordart()
Me.Errormessage = "86"
objWord.ActiveWindow.ActivePane.NewFrameset()
objWord.ActiveWindow.ActivePane.Frameset.AddNewFrame(Word.WdFramesetNewFrameLocation.wdFramesetNewFrameAbove)
With objWord.ActiveWindow.Document.Frameset.ChildFramesetItem(1)
.HeightType = Word.WdFramesetSizeType.wdFramesetSizeTypeFixed
' .HeightType = wdFramesetSizeTypePercent
.Height = 35
End With
objWord.Selection.TypeText(text:="*** Dokument im Anzeigemodus ge<67>ffnet ***")
objWord.Selection.HomeKey(Unit:=Word.WdUnits.wdLine, Extend:=Word.WdMovementType.wdExtend)
objWord.Selection.Font.Color = Word.WdColor.wdColorRed
objWord.Selection.Font.Size = 12
objWord.Selection.EndKey(Unit:=Word.WdUnits.wdLine)
objWord.Selection.ParagraphFormat.Alignment = WdParagraphAlignment.wdAlignParagraphCenter
objWord.Selection.Font.Color = WdColor.wdColorBlack
objWord.Selection.TypeParagraph()
objWord.Selection.Font.Size = 9
objWord.Selection.TypeText(text:="<EFBFBD>nderungen im Dokument werden in EDOKA nicht ber<65>cksichtigt, auch dann nicht, wenn Sie das Dokument abspeichern.")
objWord.Selection.HomeKey(Unit:=Word.WdUnits.wdLine, Extend:=Word.WdMovementType.wdExtend)
objWord.Selection.Font.Color = WdColor.wdColorBlack
objWord.Selection.HomeKey(Unit:=Word.WdUnits.wdStory)
objWord.ActiveWindow.Panes.Item(1).Activate()
If objWord.ActiveWindow.View.SplitSpecial = WdSpecialPane.wdPaneNone = True Then
objWord.ActiveWindow.ActivePane.View.Type = WdViewType.wdPrintPreview
Else
objWord.ActiveWindow.View.Type = WdViewType.wdPrintPreview
End If
objWord.CommandBars("Frames").Visible = False
Me.Errormessage = "87"
End Function
Public Sub CloseDoc()
Me.Errormessage = "88"
docWord.Close(False)
docWord = Nothing
objWord = Nothing
Me.Errormessage = "89"
End Sub
Public Sub CloseDocAndWord()
Me.Errormessage = "90"
'Rel 3.2 bud
docWord.Close(False)
docWord = Nothing
'objWord.Quit()
objWord = Nothing
Me.Errormessage = "91"
End Sub
Public Sub ActivateWord()
'Rel 3.2 bud
Me.Errormessage = "92"
docWord.Activate()
Me.Errormessage = "93"
End Sub
#End Region
#Region "Excel"
Public Function Create_Excel_Before_Fill(ByVal DokTypeNr As Long, ByVal xdata As DataTable, ByVal fname As String, Optional ByVal sKopyDokID As String = "") As Boolean
Dim i As Integer
Me.inEditMode = False
Me.Excel_Dokument = True
Me.Dokumenttypnr = DokTypeNr
DokumenTtyp.cpMainConnectionProvider = conn
DokumenTtyp.iDokumenttypnr = New SqlInt32(CType(Me.Dokumenttypnr, Int32))
DokumenTtyp.SelectOne()
Me.ProgressBar.Bar1a.Value = 31
Me.ProgressBar.Info.Text = "Office-Dokument erstellen"
Office_Vorlage.cpMainConnectionProvider = conn
Office_Vorlage.iOffice_vorlagenr = DokumenTtyp.iOffice_vorlagenr
Office_Vorlage.SelectOne()
'Tempor<6F>r-Datei
Dokument_Temp = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente")
Dokument_Temp = Dokument_Temp + Office_Vorlage.sPrefix_dokumentname.Value + ".doc"
'Nativ-Dokumentvorlage
If Not Office_Vorlage.bIdv_vorlage.Value = True Then
Dim abdatei As Boolean = False
If Office_Vorlage.sOffice_vorlage.Value Is System.DBNull.Value Then
abdatei = True
Else
If Office_Vorlage.sOffice_vorlage.Value = "" Then abdatei = True
End If
If abdatei Then
Me.Errormessage = "96"
Dim LoopCnt As Integer = 0
Dim DokumentGeladen As Boolean = False
While DokumentGeladen = False And LoopCnt < 4
Try
LoopCnt = LoopCnt + 1
'Rel 3.5 / BUD / 13.01.2005
If sKopyDokID = "" Then
Dim x As New FrmDomainOfficeVorlageDatei()
Dokument_To_Create = x.Get_From_DB(Me.Office_Vorlage.iOffice_vorlagenr.Value, Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente"))
x.Dispose()
Else
Dim objDocMgmt As New DocMgmt()
Dokument_To_Create = fname
objDocMgmt.Get_From_DB(sKopyDokID, Dokument_To_Create)
objDocMgmt = Nothing
End If
StartExcel()
Try
objExcel.Workbooks.Add(Template:=Dokument_To_Create)
Catch ex As Exception
End Try
objExcel.ActiveWorkbook.SaveAs(filename:=fname)
Me.Dokumentfilename = fname
docExcel = objExcel.ActiveWorkbook
'FileSystem.Rename(Dokument_To_Create, fname)
'StartExcel()
'Dokumentfilename = fname
'objExcel.Workbooks.Open(fname)
'docExcel = objExcel.ActiveWorkbook
DokumentGeladen = True
Catch
Me.Errormessage = "97"
DokumentGeladen = False
Try
Close_And_Destroy_excel()
Catch
End Try
Try
File.Delete(fname)
Catch
End Try
Catch
End Try
End While
Me.Errormessage = "98"
If DokumentGeladen = False Then
Me.Errormessage = "99"
MyMsg.show_standardmessage(137, MsgBoxStyle.Exclamation)
Me.ProgressBar.Visible = False
Try
objExcel.Visible = True
Catch
Me.Errormessage = "100"
StartExcel()
objExcel.Visible = True
End Try
Try
Catch
objExcel.WindowState = Excel.XlWindowState.xlMinimized
End Try
Try
'Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Maximize)
Catch
End Try
Return False
End If
'Dim x As New FrmDomainOfficeVorlageDatei()
'Dokument_To_Create = x.Get_From_DB(Me.Office_Vorlage.iOffice_vorlagenr.Value, Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente"))
'StartExcel()
'Try
' objExcel.Workbooks.Add(Template:=Dokument_To_Create)
'Catch ex As Exception
'End Try
'objExcel.ActiveWorkbook.SaveAs(filename:=fname)
'Me.Dokumentfilename = fname
'docExcel = objExcel.ActiveWorkbook
'x.Dispose()
Else
Dokument_To_Create = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_excel_vorlagen") + Office_Vorlage.sOffice_vorlage.Value
StartExcel()
Dokumentfilename = fname
objExcel.Workbooks.Add(Template:=Dokument_To_Create)
objExcel.ActiveWorkbook.SaveAs(filename:=fname)
docExcel = objExcel.ActiveWorkbook
End If
End If
IsProtected = False
'For i = 1 To docExcel.Sheets.Count
' docExcel.Sheets(i).activate()
' sheetExcel = docExcel.ActiveSheet
' sheetExcel.Unprotect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_excelvorlagen"))
' IsProtected = True
'Next i
objExcel.Visible = False
Me.ProgressBar.Bar1a.Value = 41
Me.ProgressBar.Info.Text = "Vorhandene Werte aus dem Dokument auslesen"
Excel_Werte_Auslesen(xdata)
Me.ProgressBar.Bar1a.Value = 51
Me.ProgressBar.Info.Text = "Neue und Bestehende Werte zusammenstellen"
'Me.Errormessage = "94"
'Dim i As Integer
'Me.inEditMode = False
'Me.Excel_Dokument = True
'Me.Dokumenttypnr = DokTypeNr
'DokumenTtyp.cpMainConnectionProvider = conn
'DokumenTtyp.iDokumenttypnr = New SqlInt32(CType(Me.Dokumenttypnr, Int32))
'DokumenTtyp.SelectOne()
'Me.ProgressBar.Bar1.Value = 31
'Me.ProgressBar.Info.Text = "Office-Dokument erstellen"
'Office_Vorlage.cpMainConnectionProvider = conn
'Office_Vorlage.iOffice_vorlagenr = DokumenTtyp.iOffice_vorlagenr
'Office_Vorlage.SelectOne()
''Tempor<6F>r-Datei
'Dokument_Temp = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente")
'Dokument_Temp = Dokument_Temp + Office_Vorlage.sPrefix_dokumentname.Value + ".doc"
''Nativ-Dokumentvorlage
'If Not Office_Vorlage.bIdv_vorlage.Value = True Then
' Me.Errormessage = "95"
' Dim abdatei As Boolean = False
' If Office_Vorlage.sOffice_vorlage.Value Is System.DBNull.Value Then
' abdatei = True
' Else
' If Office_Vorlage.sOffice_vorlage.Value = "" Then abdatei = True
' End If
' If abdatei Then
' Me.Errormessage = "96"
' Dim LoopCnt As Integer = 0
' Dim DokumentGeladen As Boolean = False
' While DokumentGeladen = False And LoopCnt < 4
' Try
' LoopCnt = LoopCnt + 1
' Dim x As New FrmDomainOfficeVorlageDatei()
' Dokument_To_Create = x.Get_From_DB(Me.Office_Vorlage.iOffice_vorlagenr.Value, Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente"))
' x.Dispose()
' FileSystem.Rename(Dokument_To_Create, fname)
' StartExcel()
' Dokumentfilename = fname
' objExcel.Workbooks.Open(fname)
' docExcel = objExcel.ActiveWorkbook
' DokumentGeladen = True
' Catch
' Me.Errormessage = "97"
' DokumentGeladen = False
' Try
' Close_And_Destroy_excel()
' Catch
' End Try
' Try
' File.Delete(fname)
' Catch
' End Try
' Catch
' End Try
' End While
' Me.Errormessage = "98"
' If DokumentGeladen = False Then
' Me.Errormessage = "99"
' MyMsg.show_standardmessage(137, MsgBoxStyle.Exclamation)
' Me.ProgressBar.Visible = False
' Try
' objExcel.Visible = True
' Catch
' Me.Errormessage = "100"
' StartExcel()
' objExcel.Visible = True
' End Try
' Return False
' End If
' 'Dim x As New FrmDomainOfficeVorlageDatei()
' 'Dokument_To_Create = x.Get_From_DB(Me.Office_Vorlage.iOffice_vorlagenr.Value, Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente"))
' 'StartExcel()
' 'Try
' ' objExcel.Workbooks.Add(Template:=Dokument_To_Create)
' 'Catch ex As Exception
' 'End Try
' 'objExcel.ActiveWorkbook.SaveAs(filename:=fname)
' 'Me.Dokumentfilename = fname
' 'docExcel = objExcel.ActiveWorkbook
' 'x.Dispose()
' Else
' Me.Errormessage = "101"
' Dokument_To_Create = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_excel_vorlagen") + Office_Vorlage.sOffice_vorlage.Value
' StartExcel()
' Dokumentfilename = fname
' objExcel.Workbooks.Add(Template:=Dokument_To_Create)
' objExcel.ActiveWorkbook.SaveAs(filename:=fname)
' docExcel = objExcel.ActiveWorkbook
' End If
' Me.Errormessage = "102"
' Return True
'End If
'IsProtected = False
''For i = 1 To docExcel.Sheets.Count
'' docExcel.Sheets(i).activate()
'' sheetExcel = docExcel.ActiveSheet
'' sheetExcel.Unprotect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_excelvorlagen"))
'' IsProtected = True
''Next i
'objExcel.Visible = False
'Me.ProgressBar.Bar1.Value = 41
'Me.ProgressBar.Info.Text = "Vorhandene Werte aus dem Dokument auslesen"
'Excel_Werte_Auslesen(xdata)
'Me.ProgressBar.Bar1.Value = 51
'Me.ProgressBar.Info.Text = "Neue und Bestehende Werte zusammenstellen"
'Me.Errormessage = "103"
Return True
End Function
Public Sub Open_Excel(ByVal fname As String, ByVal xdata As DataTable, ByVal doktypeNr As Long)
Me.Errormessage = "104"
Dim i As Integer
Me.Dokumenttypnr = doktypeNr
Me.inEditMode = True
DokumenTtyp.cpMainConnectionProvider = conn
DokumenTtyp.iDokumenttypnr = New SqlInt32(CType(Me.Dokumenttypnr, Int32))
DokumenTtyp.SelectOne()
Me.Excel_Dokument = True
Me.ProgressBar.Bar1a.Value = 41
Me.ProgressBar.Info.Text = "Office-Dokument <20>ffnen"
Office_Vorlage.cpMainConnectionProvider = conn
Office_Vorlage.iOffice_vorlagenr = DokumenTtyp.iOffice_vorlagenr
Office_Vorlage.SelectOne()
StartExcel()
Dokumentfilename = fname
objExcel.Workbooks.Open(fname)
docExcel = objExcel.ActiveWorkbook
objExcel.Visible = False
Me.ProgressBar.Bar1a.Value = 41
Me.ProgressBar.Info.Text = "Vorhandene Werte aus dem Dokument auslesen"
'For i = 1 To docExcel.Sheets.Count
'docExcel.Sheets(i).activate()
'sheetExcel = docExcel.ActiveSheet
'sheetExcel.Unprotect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_excelvorlagen"))
'IsProtected = True
'Next i
Excel_Werte_Auslesen(xdata)
Me.ProgressBar.Bar1a.Value = 51
Me.ProgressBar.Info.Text = "Neue und Bestehende Werte zusammenstellen"
Me.Errormessage = "105"
End Sub
Public Sub Excel_Werte_Auslesen(ByVal xdata As DataTable)
Me.Errormessage = "106"
Dim i As Integer
Dim i1 As Integer
Dim sheets As Integer
sheets = docExcel.Sheets.Count
For i = 1 To sheets
docExcel.Sheets(i).activate()
For i1 = 0 To xdata.Rows.Count - 1
Try
objExcel.Range(docExcel.Names.Item(xdata.Rows(i1).Item("feldname")).NameLocal).Select()
xdata.Rows(i1).Item("oldvalue") = objExcel.Selection.text
xdata.Rows(i1).Item("used") = 1
Catch
End Try
Next
Next
Me.Errormessage = "107"
End Sub
Public Sub Excel_Vervollstaendigen(ByVal xdata As DataTable)
Me.Errormessage = "108"
Dim Sheetnr_fuer_Cursor As Integer
Me.ProgressBar.Bar1a.Value = 61
Me.ProgressBar.Info.Text = "Dokumentwerte <20>bertragen"
Dim i As Integer
Dim i1 As Integer
Dim sheets As Integer
sheets = docExcel.Sheets.Count
Sheetnr_fuer_Cursor = 0
For i = 1 To sheets
docExcel.Sheets(i).activate()
For i1 = 0 To xdata.Rows.Count - 1
Try
If xdata.Rows(i1).Item("beginntextmarke") = "TGEDKCursor" Or _
xdata.Rows(i1).Item("beginntextmarke") = "TGEDKCursorB" Or _
xdata.Rows(i1).Item("feldname") = "TGEDKCursorB" Or _
xdata.Rows(i1).Item("feldname") = "TGEDKCursor" Then
Try
objExcel.Range(docExcel.Names.Item(xdata.Rows(i1).Item("feldname")).NameLocal).Select()
Cursor_Positionieren = True
Sheetnr_fuer_Cursor = i
Catch
End Try
Else
objExcel.Range(docExcel.Names.Item(xdata.Rows(i1).Item("feldname")).NameLocal).Select()
objExcel.ActiveCell.FormulaR1C1 = convert_excel(xdata.Rows(i1).Item("xvalue"))
End If
Catch
End Try
Next
'docExcel.Sheets(i).largescroll(down:=-10)
Next
Me.Errormessage = "109"
'EDEX Banklagernd
If DokumenTtyp.bZu_retournieren.Value = True Or DokumenTtyp.iDoktypbedingteretournierung.Value > 0 Or Me.SaveBLDossier = True Then
Generate_Barcodes()
End If
'If IsProtected Then
' For i = 1 To docExcel.Sheets.Count
'docExcel.Sheets(i).activate()
'sheetExcel = docExcel.ActiveSheet
'sheetExcel.Protect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_excelvorlagen"))
'IsProtected = True
' Next i
'End If
Me.Errormessage = "110"
objExcel.Sheets(1).activate()
If Cursor_Positionieren Then
Try
docExcel.Sheets(Sheetnr_fuer_Cursor).activate()
objExcel.Range(docExcel.Names.Item("TGEDKCursor").NameLocal).Select()
Catch
Try
docExcel.Sheets(Sheetnr_fuer_Cursor).activate()
objExcel.Range(docExcel.Names.Item("TGEDKCursorB").NameLocal).Select()
Catch
End Try
End Try
Else
objExcel.Sheets(1).activate()
End If
Me.ProgressBar.Hide()
Me.Errormessage = "111"
'rel 4.0 handle DirektErstellung <20>ber Avaloq-Schnittstelle
If IsNothing(objSpooler) = False Then
If objSpooler.NoEdit = 2 Then
docExcel.Close(SaveChanges:=True)
objExcel.Quit()
WordWatch.Stopp()
Finishing()
'rel 372 EDOKA nach vorne bringen
'Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Maximize)
Thread.CurrentThread.Sleep(100)
Exit Sub
End If
End If
Control_Word()
End Sub
#End Region
#End Region
#Region "Diverse_Funktionen"
Public Function Change_Docname(ByVal s As String) As String
Me.Errormessage = "112"
Dim splitt
Dim t As String
splitt = Split(s, ".")
t = splitt(0) + splitt(1) + splitt(2)
splitt = Split(t, ":")
t = splitt(0) + splitt(1) + splitt(2)
Change_Docname = t
Me.Errormessage = "113"
End Function
Function convert(ByVal x As String) As String
Me.Errormessage = "87"
Dim s As String
Dim s1 As String
Dim i As Integer
s = x
i = InStr(s, Chr(13))
While i > 0
s = Left(s, i - 1) & "#" & Right(s, Len(s) - (i))
If Mid(s, i + 1, 1) = Chr(10) Then
s = Left(s, i) & Right(s, Len(s) - (i + 1))
End If
i = InStr(s, Chr(13))
End While
i = InStr(s, "#")
While i > 0
s = Left(s, i - 1) & vbCrLf & Right(s, Len(s) - (i))
i = InStr(s, "#")
End While
convert = s
Me.Errormessage = "88"
End Function
Function convert_wordfelder(ByVal x As String) As String
Me.Errormessage = "89"
Dim s As String
Dim s1 As String
Dim i As Integer
s = x
i = InStr(s, Chr(13))
While i > 0
s = Left(s, i - 1) & "#" & Right(s, Len(s) - (i))
If Mid(s, i + 1, 1) = Chr(10) Then
s = Left(s, i) & Right(s, Len(s) - (i + 1))
End If
i = InStr(s, Chr(13))
End While
i = InStr(s, "#")
While i > 0
s = Left(s, i - 1) & Chr(11) & Right(s, Len(s) - (i))
i = InStr(s, "#")
End While
convert_wordfelder = s
Me.Errormessage = "90"
End Function
Function convert_excel(ByVal x As String) As String
Me.Errormessage = "91"
Dim s As String
Dim s1 As String
Dim i As Integer
s = x
i = InStr(s, Chr(13))
While i > 0
s = Left(s, i - 1) & "#" & Right(s, Len(s) - (i))
If Mid(s, i + 1, 1) = Chr(10) Then
s = Left(s, i) & Right(s, Len(s) - (i + 1))
End If
i = InStr(s, Chr(13))
End While
i = InStr(s, "#")
While i > 0
s = Left(s, i - 1) & Chr(10) & Right(s, Len(s) - (i))
i = InStr(s, "#")
End While
convert_excel = s
Me.Errormessage = "92"
End Function
#End Region
#Region "Reporting"
Public Sub Get_Docvars(ByVal DokTypeNr As Long)
Dim id As String
Dim rec As New edokadb.clsReporting_Dokumenttyp()
rec.cpMainConnectionProvider = conn
conn.OpenConnection()
id = Now
Dim i As Short
For i = 1 To docWord.Bookmarks.Count
Try
If Left(UCase(docWord.Bookmarks.Item(i).Name), 2) <> "BK" And Left(UCase(docWord.Bookmarks.Item(i).Name), 4) <> "TGAM" Then
rec.sID = New SqlString(CType(id, String))
rec.sOFBM = New SqlString(CType(docWord.Bookmarks.Item(i).Name, String))
rec.Insert()
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
Next
For i = 1 To docWord.FormFields.Count
rec.sID = New SqlString(CType(id, String))
rec.sOFFeld = New SqlString(CType(docWord.FormFields.Item(i).Name, String))
rec.Insert()
Next
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.[sp_reporting_dokumenttyp]"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Try
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@id", SqlDbType.VarChar, 25, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, id))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttypnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, DokTypeNr))
If Globals.MyMsg.Show_MessageYesNo(15) = MsgBoxResult.Yes Then
scmCmdToExecute.Parameters.Add(New SqlParameter("@VFInaktivieren", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
Else
scmCmdToExecute.Parameters.Add(New SqlParameter("@VFInaktivieren", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
End If
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Finally
scmCmdToExecute.Dispose()
End Try
Dim f As New frmReporting()
f.show_report_dokumenttypVFelder(Dokumenttypnr, id)
f.Show()
scmCmdToExecute.Dispose()
scmCmdToExecute = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.[sp_reporting_dokumenttyp]"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Try
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.CommandText = "dbo.[sp_reporting_dokumenttyp_delete]"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@id", SqlDbType.VarChar, 25, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, id))
scmCmdToExecute.ExecuteNonQuery()
Catch es As Exception
MsgBox(es.Message)
End Try
conn.CloseConnection(True)
End Sub
#End Region
#Region "ControlWord"
Private Sub Control_Word()
Me.Errormessage = "120"
If Me.DokumenTtyp.bNurnative.Value = True Then
Restore(1)
If Me.Excel_Dokument Then
objExcel.Visible = True
Try
'Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Minimze)
Catch
End Try
Exit Sub
End If
objWord.Visible = True
Try
'Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_SHOW)
Catch
End Try
Exit Sub
End If
Me.Errormessage = "121"
Me.DocReadonly = False
Me.Dokument_Saved = False
'FileWatcher()
' Init_ObjWatcher()
Me.Errormessage = "122"
WATCHFILE()
End Sub
Private Sub Init_ObjWatcher()
Me.Errormessage = "123"
Me.objWatcher.Path = "c:\edokatemp"
AddHandler objWatcher.Changed, AddressOf logchange
Me.objWatcher.Filter = Me.DokumentName
Me.objWatcher.EnableRaisingEvents = True
Me.Errormessage = "124"
End Sub
Private Sub logchange(ByVal source As Object, ByVal e As _
System.IO.FileSystemEventArgs)
Me.Errormessage = "125"
If e.ChangeType = IO.WatcherChangeTypes.Changed Then
If UCase(e.FullPath) = UCase(Me.objWatcher.Path + "\" + Me.DokumentName) Then
Dim xtime As DateTime
xtime = File.GetLastWriteTime(Me.Dokumentfilename)
Dim cxtime As String = xtime.ToString
Dim csavetime As String = Save_DateTime.ToString
Dim diff As Integer = DateDiff(DateInterval.Second, Save_DateTime, xtime)
If diff > 2 Then
Save_DateTime = File.GetLastWriteTime(Me.Dokumentfilename)
Me.objWatcher.EnableRaisingEvents = False
Dim fn As String
fn = objWatcher.Path + "\" + Format(Now, "yyyyMMdd").ToString + "_" + Me.DokumentName
FileCopy(objWatcher.Path + "\" + Me.DokumentName, fn)
Save_Doc_Temp(fn)
File.Delete(fn)
'MsgBox("Das Dokument wurde gespeichert.")
Me.objWatcher.EnableRaisingEvents = True
End If
End If
End If
Me.Errormessage = "126"
End Sub
Dim savecount As Integer = 0
Private Sub objWord_DocumentBeforeSave(ByVal Doc As Word.Document, ByRef SaveAsUI As Boolean, ByRef Cancel As Boolean) Handles objWord.DocumentBeforeSave
Me.Errormessage = "127"
If Me.DokumenTtyp.bNurnative.Value = True Then
Exit Sub
End If
If Doc.Name = Me.DokumentName Then
If savecount <> 0 Then Exit Sub
Dim fn As String
Dim fn1 As String
savecount = 1
Thread.Sleep(800)
docWord.Save()
Thread.Sleep(800)
fn = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Me.DokumentName
fn1 = Globals.Applikationsdaten.Rows(0).Item("pfad_temporaer_dokumente") + Format(Now, "yyyMMddhhmmss" + "_" + Me.DokumentName)
FileCopy(fn, fn1)
Save_Doc_Temp(fn1)
File.Delete(fn1)
savecount = 0
End If
Me.Errormessage = "128"
End Sub
Private Sub Control_Word_readonly()
Me.Errormessage = "129"
Me.DocReadonly = True
Me.Dokument_Saved = False
WATCHFILE()
Me.Errormessage = "130"
End Sub
Private Function WATCHFILE()
Me.Errormessage = "131"
'Wordwatch - <20>berpr<70>fung auf ge<67>ffnete
If Not Me.DocReadonly Then Save_DateTime = File.GetLastWriteTime(Me.Dokumentfilename)
WordWatch.Filename = Me.DokumentName
If Me.Excel_Dokument Then
WordWatch.ApplicationType = 2
objExcel.ActiveWindow.WindowState = Excel.XlWindowState.xlMaximized
objExcel.Visible = True
Disable_Enable_MenuFunctions_Excel(False)
Else
WordWatch.ApplicationType = 1
Disable_Enable_MenuFunctions(False)
objWord.Visible = True
objWord.Activate()
End If
Me.Errormessage = "132"
Word_Active = True
Try
'Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_SHOW)
Catch
End Try
Globals.PerfMon.insert_entry(Me.DokumentID + " Start <20>berwachung")
WordWatch.Start()
Dim hnd As Integer
Me.Errormessage = "133"
Try
hnd = Win32API.FindWindow(vbNullString, WordWatch.WindowName)
'Win32API.ShowWindow(hnd, Win32API.SW_Maximize)
' Ergibt Fehler bei Rel 4.0
'Win32API.BringWindowToTop(hnd)
Catch
End Try
End Function
Private Sub Finishing() Handles WordWatch.DocumentClosed
Me.Errormessage = "134"
objWatcher.EnableRaisingEvents = False
Finished = True
Thread.Sleep(100)
If IsNothing(objSpooler) = False Then
If objSpooler.NoEdit <> 2 And Me.bldokument = False Then
If WordWatch.doc_is_active Then Exit Sub
End If
Else
If Me.bldokument = False Then
If WordWatch.doc_is_active Then Exit Sub
End If
End If
WordWatch.Stopp()
Globals.PerfMon.insert_entry(Me.DokumentID + " Stop <20>berwachung")
'Weil 2x Funktion aufgeruft wird! Keine Ahnung wiso... naja who cares ;-)
If File.Exists(Me.Dokumentfilename) = False Then Exit Sub
Dim i As Integer
If Not Me.Excel_Dokument Then
If Globals.Words.Count = 0 Then Disable_Enable_MenuFunctions(True)
Else
If Globals.Words.Count = 0 Then Disable_Enable_MenuFunctions_Excel(True)
End If
If Me.DocReadonly Then
Delete_File()
Exit Sub
End If
Me.Errormessage = "135"
Dim xtime As DateTime
xtime = File.GetLastWriteTime(Me.Dokumentfilename)
'Gibt Fehler bei Automatischer Erstellung, wird eh nicht gebraucht
'kann nur save_Data() aufgerufen werden!!
'--------------------------------------------------------------------
Dim diff As Integer
If IsNothing(objSpooler) = False Then
If objSpooler.NoEdit <> 2 Then
Dim cxtime As String = xtime.ToString
Dim csavetime As String = Save_DateTime.ToString
If Me.bldokument = False Then
diff = DateDiff(DateInterval.Second, Save_DateTime, xtime)
End If
'Sofern das Dokument <20>ber eine Dokumentpaket erstellt wurde, dieses aus der DP_Collection l<>schen
Try
Try
Dim i2 As Integer
For i2 = 1 To Globals.DP_Collection.Count
If Globals.DP_Collection.Item(i2) = Me.DokumentID Then
Globals.DP_Collection.Remove(i2)
End If
Exit For
Next
Catch
End Try
Catch
End Try
End If
Else
Dim cxtime As String = xtime.ToString
Dim csavetime As String = Save_DateTime.ToString
If Me.bldokument = False Then
diff = DateDiff(DateInterval.Second, Save_DateTime, xtime)
End If
'Sofern das Dokument <20>ber eine Dokumentpaket erstellt wurde, dieses aus der DP_Collection l<>schen
Try
Try
Dim i2 As Integer
For i2 = 1 To Globals.DP_Collection.Count
If Globals.DP_Collection.Item(i2) = Me.DokumentID Then
Globals.DP_Collection.Remove(i2)
End If
Exit For
Next
Catch
End Try
Catch
End Try
End If
If IsNothing(objSpooler) = True Then
If diff > 2 Or Me.bldokument = True Then
' If cxtime <> csavetime Then
' If xtime <> Save_DateTime Then
' If File.GetLastWriteTime(Me.Dokumentfilename) <> Save_DateTime Then
Globals.PerfMon.insert_entry(Me.DokumentID + " Start Datensichern")
Save_Data()
Globals.PerfMon.insert_entry(Me.DokumentID + " Ende Datensichern")
Else
Globals.PerfMon.insert_entry(Me.DokumentID + " Start Restore")
Restore_Data()
Globals.PerfMon.insert_entry(Me.DokumentID + " Ende Restore")
End If
Else
If objSpooler.NoEdit = 2 Or diff > 2 Or Me.bldokument = True Then
Globals.PerfMon.insert_entry(Me.DokumentID + " Start Datensichern")
Save_Data()
Globals.PerfMon.insert_entry(Me.DokumentID + " Ende Datensichern")
Else
Globals.PerfMon.insert_entry(Me.DokumentID + " Start Restore")
Restore_Data()
Globals.PerfMon.insert_entry(Me.DokumentID + " Ende Restore")
End If
End If
Me.Errormessage = "136"
If Me.Excel_Dokument = True Then
Try
Try
objExcel.Visible = True
objExcel.Workbooks.Close()
objExcel.Application.Quit()
docWord = Nothing
objWord = Nothing
Catch
End Try
docExcel = Nothing
objExcel = Nothing
Catch
End Try
Else
Me.Errormessage = "137"
Try
objWord = Nothing
docWord = Nothing
Catch
End Try
End If
Me.Errormessage = "138"
Try
Globals.PerfMon.insert_entry(Me.DokumentID + " Ende Wordbearbeitung")
Words.Remove(Me.DokumentName)
If Me.Excel_Dokument = True Then
If Globals.Words.Count = 0 Then
Me.StartExcel()
objExcel.Visible = False
Disable_Enable_MenuFunctions_Excel(True)
objExcel.Quit()
objExcel = Nothing
End If
Else
If Globals.Words.Count = 0 Then
StartWord()
objWord.NormalTemplate.Saved = True
objWord.Visible = False
Disable_Enable_MenuFunctions(True)
If Me.WordnewInstance = True Then
objWord.Quit()
Else
objWord.Visible = True
End If
objWord = Nothing
End If
End If
DivFnkt.Status_Dokumentbearbeitung(2, Me.DokumentID, False, "")
Catch
Finally
Try
' Rel 4.0 Fensterhandling Problem
' Handle verweis auf Prozess EDOKA...
Dim p As Process
Dim MyProcesses() As Process = _
Process.GetProcessesByName( _
Process.GetCurrentProcess().ProcessName)
For Each p In MyProcesses
If (p.Id = Process.GetCurrentProcess().Id) Then
Globals.Apphandle = p.MainWindowHandle()
End If
Next
Win32API.SetActiveWindow(Globals.Apphandle)
Win32API.BringWindowToTop(Globals.Apphandle)
'Rel. 4.03 von SW_Maximize auf SW_Restore ge<67>ndert
Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Maximize)
Catch
End Try
End Try
Me.Errormessage = "139"
End Sub
Public Function FileWatcher()
Me.Errormessage = "140"
Save_DateTime = File.GetLastWriteTime(Me.Dokumentfilename)
End Function
Private Sub filechange(ByVal source As Object, ByVal e As System.IO.FileSystemEventArgs)
Me.Errormessage = "141"
If e.ChangeType = IO.WatcherChangeTypes.Changed Then
MsgBox(e.FullPath & " " & e.Name)
Me.Dokument_Saved = True
End If
End Sub
#End Region
#Region "Save / Restore"
Public Function Save_Data()
Me.Errormessage = "142"
WordWatch.Stopp()
Save_Doc()
Update_Dokumentdetails()
Dim statush As New Statushandling()
statush.check_abschluss(Me.DokumentID, Globals.MitarbeiterNr)
Me.Errormessage = "143"
End Function
Private Sub Change_Dokumentstatus()
Me.Errormessage = "144"
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_archiv_changedokumentstatus"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.StatusChanges_Dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@status", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.StatusChanges_Status))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Finally
End Try
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
Me.Errormessage = "145"
End Sub
Public Function Restore_Data()
Me.Errormessage = "146"
WordWatch.Stopp()
If Me.CreateDoc = True Then
Restore(1)
' Rel 4.0 Fensterhandling Problem
' Handle verweis auf Prozess EDOKA...
Dim p As Process
Dim Ret As Int32
Dim hWndMain As IntPtr
Dim MyProcesses() As Process = _
Process.GetProcessesByName( _
Process.GetCurrentProcess().ProcessName)
For Each p In MyProcesses
If (p.Id = Process.GetCurrentProcess().Id) Then
Globals.Apphandle = p.MainWindowHandle()
End If
Next
Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Minimze)
Try
'Rel. 4.03 Von SW_Maximize auf SW_Restore ge<67>ndert
Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Maximize)
Catch
End Try
Dim s As String
s = MyTxt.Get_Meldungstext(80) + vbCrLf + vbCrLf + "Partner: " + Me.txtPartner + vbCrLf + "Dokument: " & Me.txtDokumenttyp
Dim f As New frmHinweismeldung1()
Globals.PerfMon.insert_entry(Me.DokumentID + " Dokumentbearbeitung abgebrochen: Partner " + Me.txtPartner)
f.MsgBoxStyle = 1
f.Label1.Text = s
If Not Me.DokumenTtyp.bNurnative.Value = True Then
f.ShowDialog()
End If
' MsgBox(s, MsgBoxStyle.Critical)
Else
Restore(2)
End If
DivFnkt.Status_Dokumentbearbeitung(2, Me.DokumentID, False, "")
Me.Errormessage = "147"
End Function
Public Function Restore(ByVal typ As Integer)
Me.Errormessage = "148"
Restore_Datasets()
End Function
Public Function Save_Doc()
Me.Errormessage = "149"
Globals.PerfMon.insert_entry(Me.DokumentID + " Start Dokument sichern")
Dim docsave As New DocMgmt()
Globals.PerfMon.insert_entry(Me.DokumentID + "'-- Start Dokument auf DB sichern")
docsave.Save_To_DB(Me.DokumentID, Me.Dokumentfilename)
docsave = Nothing
Globals.PerfMon.insert_entry(Me.DokumentID + "'-- Ende Dokument auf DB sichern")
If Me.Dokumentcoldindex_Changed Then
Archivfnkt.insert_coldupdate_status(Me.save_dokumentcoldindex, Me.DokumentID, Me.dokumentcoldindex_status)
End If
If Me.Ersetzte_Dokumente_Reaktivieren = True Then
Dokumente_Reaktivieren(Me.DokumentID)
End If
'huttu
Dim doarchivfnkt As Boolean
If Me.Dokumentidbr <> "" And Me.CreateDoc Then doarchivfnkt = True
If Me.Save_Dokumentbr.Rows.Count > 0 Then
doarchivfnkt = True
End If
If doarchivfnkt Then
If Me.Dokumentcoldindex_changedbr Then
Archivfnkt.insert_coldupdate_status(Me.save_dokumentcoldindexbr, Me.Dokumentidbr, Me.dokumentcoldindex_statusbr)
End If
If Me.Ersetzte_Dokumente_Reaktivierenbr = True Then
Dokumente_Reaktivieren(Me.Dokumentidbr)
End If
DivFnkt.Status_Dokumentbearbeitung(2, Me.Dokumentidbr, False, "")
End If
DivFnkt.Status_Dokumentbearbeitung(2, Me.DokumentID, False, "")
Delete_File()
Globals.PerfMon.insert_entry(Me.DokumentID + " Ende Dokument sichern")
Me.Errormessage = "150"
End Function
Public Function Save_Doc_Temp(ByVal Dokumentfile As String)
Me.Errormessage = "151"
Dim docsave As New DocMgmt()
docsave.Save_To_DB(Me.DokumentID, Dokumentfile)
docsave = Nothing
File.Delete(Dokumentfile)
Me.Errormessage = "152"
End Function
Public Function Dokumente_Reaktivieren(ByVal dokumentid As String)
Me.Errormessage = "153"
Dim da As New SqlDataAdapter("Select * from dokumentersetzen where hauptdokumentid='" & dokumentid & "'", Globals.sConnectionString)
Dim ds As New DataSet()
Dim i As Integer
da.Fill(ds, "Ersetzen")
For i = 0 To ds.Tables(0).Rows.Count - 1
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Dokument_reaktivieren"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
conn.OpenConnection()
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ds.Tables(0).Rows(i).Item(2)))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiter", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
conn.CloseConnection(True)
Dim dt As DataTable
Dim sth As New Statushandling()
dt = sth.get_coldindex_and_statusnr(ds.Tables(0).Rows(i).Item(2), False, True)
Archivfnkt.insert_coldupdate_reaktivieren(dt, ds.Tables(0).Rows(i).Item(2), "Aktuell")
sth.Dispose()
End Try
Next
da.Dispose()
ds.Dispose()
Me.Errormessage = "154"
End Function
Public Function Update_Dokumentdetails()
Me.Errormessage = "155"
Globals.PerfMon.insert_entry(Me.DokumentID + " Start Dokumentdetails sichern")
Dim doc As New edokadb.clsDokument()
doc.cpMainConnectionProvider = conn
conn.OpenConnection()
doc.sDokumentid = New SqlString(CType(Me.DokumentID, String))
doc.SelectOne()
doc.daMutiertam = New SqlDateTime(CType(Microsoft.VisualBasic.Now, DateTime))
doc.Update()
Dim statush As New Statushandling()
If (doc.iVerantwortlich.Value <> Globals.MitarbeiterNr) Then
If Me.save_stv = 1 Then
If doc.iVerantwortlich.Value <> Me.save_verantwortlicher Then
If Me.txtBemerkung_Verantwortlicher <> "" Then
statush.BemerkungVerantwortlicher = Me.txtBemerkung_Verantwortlicher
End If
statush.Meldung_Verantwortlicher(Me.DokumentID, doc.iVerantwortlich.Value)
End If
Else
If Me.txtBemerkung_Verantwortlicher <> "" Then
statush.BemerkungVerantwortlicher = Me.txtBemerkung_Verantwortlicher
End If
statush.Meldung_Verantwortlicher(Me.DokumentID, doc.iVerantwortlich.Value)
End If
End If
If Me.send_statusmessage = True Then
statush.Meldung_Status(Me.DokumentID, doc.iStatusnr.Value)
End If
statush.Dispose()
doc.Dispose()
conn.CloseConnection(True)
Globals.PerfMon.insert_entry(Me.DokumentID + " Ende Dokumentdetails sichern")
Me.Errormessage = "156"
'Rel. 4.1
Check_Mailversand()
End Function
'Rel. 4.1
Private Function Check_Mailversand()
Try
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Check_BearbeitungsMail"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.DokumentID))
scmCmdToExecute.Parameters.Add(New SqlParameter("@doktypnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.Dokumenttypnr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@SaveHistoryStatusnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.save_historystatus))
scmCmdToExecute.ExecuteNonQuery()
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
Catch ex As Exception
End Try
End Function
Public Function Delete_File()
Me.Errormessage = "157"
Globals.PerfMon.insert_entry(Me.DokumentID + " Start physisches Dokument l<>schen")
Try
File.Delete(Me.Dokumentfilename)
Catch
End Try
' RaiseEvent OfficeFinished()
Globals.PerfMon.insert_entry(Me.DokumentID + " Ende physisches Dokument l<>schen")
Me.Errormessage = "158"
End Function
Public Sub Restore_Datasets()
Me.Errormessage = "159"
Globals.PerfMon.insert_entry(Me.DokumentID + " Start Restore Details")
Dim f As New FrmRestore()
f.Visible = False
f.Width = 1
f.Height = 1
f.Show()
f.Refresh()
Try
Restore_Coldindex(Me.Save_ColdIndex, Me.DokumentID)
Restore_Dokumentwerte(Me.Save_Dokumentwerte, Me.DokumentID)
Restore_Notizen(Me.Save_Notizen, Me.DokumentID)
Restore_InfoEmpfaenger(Me.Save_Dokumentinfomeldungen, Me.DokumentID)
Restore_dokumentzuordnungen(Me.Save_Dokumentzuordnungen, Me.DokumentID)
'Rel. 4.03
If Not Me.Save_DokumentFunktionen Is Nothing Then
Restore_Dokumentfunktionen(Me.Save_DokumentFunktionen, Me.DokumentID)
End If
Restore_Statushistory(Me.save_historystatus, Me.DokumentID)
Restore_Dokumentersetzen(Me.save_dokumentersetzen, Me.DokumentID)
If Me.CreateDoc = True Then
delete_dokumentstatus(Me.DokumentID)
End If
If Me.DokumenTtyp.bNurnative.Value <> True Then Delete_File()
f.DokumentID = Me.DokumentID
f.SaveDocument = Me.Save_Dokument
f.NeuesDokument = Me.CreateDoc
f.Restore_Dokument()
Dim dorestorebr As Boolean = False
'Bedingte Retournierung
If Me.Dokumentidbr <> "" And Me.CreateDoc Then dorestorebr = True
If Me.Save_Dokumentbr.Rows.Count > 0 Then
dorestorebr = True
End If
'Verweis-Dokument im Ausl<73>ser bei Bedingter Retournierung richtig stellen
If dorestorebr And Not Me.CreateDoc Then
Dim dok As New edokadb.clsDokument()
dok.cpMainConnectionProvider = conn
dok.sDokumentid = New SqlString(CType(Me.DokumentID, String))
dok.SelectOne()
dok.sBedRDokumentid = New SqlString(CType(Me.dokumentidaltbr, String))
conn.OpenConnection()
dok.Update()
conn.CloseConnection(True)
dok.Dispose()
End If
If Me.Dokumentcoldindex_Changed = True Then Archivfnkt.Restore_Coldindex(Me.save_dokumentcoldindex, Me.DokumentID)
If Me.dokumentid_changed Then Archivfnkt.change_dokumentid(Me.DokumentID, Me.dokumentidalt)
If dorestorebr = True Then
Restore_Coldindex(Me.Save_ColdIndexbr, Me.Dokumentidbr)
Restore_Dokumentwerte(Me.Save_Dokumentwertebr, Me.Dokumentidbr)
Restore_Notizen(Me.Save_Notizenbr, Me.Dokumentidbr)
Restore_InfoEmpfaenger(Me.Save_Dokumentinfomeldungenbr, Me.Dokumentidbr)
Restore_dokumentzuordnungen(Me.Save_Dokumentzuordnungenbr, Me.Dokumentidbr)
Restore_Dokumentfunktionen(Me.Save_DokumentFunktionenbr, Me.Dokumentidbr)
Restore_Statushistory(Me.save_historystatusbr, Me.Dokumentidbr)
Restore_Dokumentersetzen(Me.save_dokumentersetzenbr, Me.Dokumentidbr)
If Me.CreateDoc = True Then
delete_dokumentstatus(Me.Dokumentidbr)
End If
' If me.CreateDoc=False Me.Save_Dokumentbr.Rows.Count > 0 Then
f.DokumentID = Me.Dokumentidbr
f.SaveDocument = Me.Save_Dokumentbr
f.NeuesDokument = Me.CreateDoc
f.Restore_Dokument()
If Me.Dokumentcoldindex_changedbr = True Then Archivfnkt.Restore_Coldindex(Me.save_dokumentcoldindexbr, Me.Dokumentidbr)
If Me.dokumentid_changedbr Then Archivfnkt.change_dokumentid(Me.Dokumentidbr, Me.dokumentidaltbr)
' End If
End If
f.Close()
f.Dispose()
Catch ex As Exception
MsgBox(ex.Message)
f.Close()
f.Dispose()
'Rel 4.0 Eintrag wegen Fensterhandling Problematik!
'Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Maximize)
Dim s As String
s = MyTxt.Get_Meldungstext(84) + vbCrLf + vbCrLf + "Partner: " + Me.txtPartner + vbCrLf + "Dokument: " & Me.txtDokumenttyp
Dim f1 As New frmHinweismeldung1()
f1.MsgBoxStyle = 1
Globals.PerfMon.insert_entry(Me.DokumentID + " Dokument zur<75>cksetzen fehlgeschlagen: Partner: " + Me.txtPartner)
f1.Label1.Text = s
f1.ShowDialog()
f1.Dispose()
End Try
Globals.PerfMon.insert_entry(Me.DokumentID + " Ende Restore Details")
Me.Errormessage = "160"
End Sub
Private Sub Restore_Notizen(ByVal Save_Notizen As DataTable, ByVal Dokumentid As String)
Me.Errormessage = "161"
'Sofern keine Notizen vorhanden sind, Sub verlassen
Dim i As Integer
Dim nnr As Long
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_Notizen"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
'Restore der alten notizen
For i = 0 To Save_Notizen.Rows.Count - 1
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Notizen.Rows(i).Item("dokumentid")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@notiznr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Notizen.Rows(i).Item("notiznr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@betreff", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Notizen.Rows(i).Item("betreff")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Notizen.Rows(i).Item("notiz")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Notizen.Rows(i).Item("mutiert_am")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Notizen.Rows(i).Item("mutierer")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Notizen.Rows(i).Item("aktiv")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
Next
Me.Errormessage = "162"
'L<>schen der neuen Notizen
nnr = 0
'Rel. 4.03 - Umbau der Restore-Funktion
For i = 0 To Save_Notizen.Rows.Count - 1
If Not Save_Notizen.Rows(i).Item("notiznr") Is System.DBNull.Value Then
If Save_Notizen.Rows(i).Item("notiznr") > nnr Then
nnr = Save_Notizen.Rows(i).Item("notiznr")
End If
End If
' If Save_Notizen.Rows(i).Item("notiznr") > nnr Then nnr = Save_Notizen.Rows(i).Item("notiznr")
Next
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@notiznr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, nnr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@betreff", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Microsoft.VisualBasic.Now))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 2))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
Me.Errormessage = "163"
End Sub
Private Sub Restore_Coldindex(ByVal save_coldindex As DataTable, ByVal dokumentid As String)
Me.Errormessage = "164"
Dim i As Integer
Dim nnr As Long
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_ColdIndex"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
If Me.CreateDoc = True Then
'Coldindexwerte bei neuem Dokument l<>schen
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@coldindexwertnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@IndexFeldNr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Now))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 2))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Restore Coldindex - Delete::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
End Try
Exit Sub
End If
Me.Errormessage = "165"
'Restore der alten Indexwerte
For i = 0 To save_coldindex.Rows.Count - 1
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_coldindex.Rows(i).Item("dokumentid")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@coldindexwertnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_coldindex.Rows(i).Item("coldindexwertnr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@IndexFeldNr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_coldindex.Rows(i).Item("cold_indexfeldnr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_coldindex.Rows(i).Item("wert")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_coldindex.Rows(i).Item("mutiert_am")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_coldindex.Rows(i).Item("mutierer")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_coldindex.Rows(i).Item("aktiv")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Restore Coldindex::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
Next
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
Me.Errormessage = "166"
End Sub
Private Sub Restore_Dokumentwerte(ByVal SAVE_DOKUMENTWERTE As DataTable, ByVal dokumentid As String)
Me.Errormessage = "167"
Dim i As Integer
Dim nnr As Long
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_Dokumentwerte"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
If Me.CreateDoc = True Then
'Coldindexwerte bei neuem Dokument l<>schen
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentinfonr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Now))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 2))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Restore Coldindex - Delete::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
End Try
Exit Sub
End If
Me.Errormessage = "168"
'Restore der alten Indexwerte
For i = 0 To SAVE_DOKUMENTWERTE.Rows.Count - 1
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("dokumentid")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentinfonr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("dokumentinfonr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("inhalt")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("mutiert_am")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("mutierer")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("aktiv")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Restore Coldindex::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
Next
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
Me.Errormessage = "169"
End Sub
Private Sub Restore_InfoEmpfaenger(ByVal Save_Dokumentinfomeldungen As DataTable, ByVal dokumentid As String)
Me.Errormessage = "167"
Dim i As Integer
Dim nnr As Long
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_DokumentInfoEmpfaenger"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
For i = 0 To Save_Dokumentinfomeldungen.Rows.Count - 1
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentinfomeldungen.Rows(i).Item("dokumentid")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentinfomeldungnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentinfomeldungen.Rows(i).Item("dokumentinfomeldungnr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@empfaenger", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentinfomeldungen.Rows(i).Item("empfaengernr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentinfomeldungen.Rows(i).Item("inhalt")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@meldungnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentinfomeldungen.Rows(i).Item("meldungstext")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@beistatus", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentinfomeldungen.Rows(i).Item("beistatus")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentinfomeldungen.Rows(i).Item("mutiert_am")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentinfomeldungen.Rows(i).Item("mutierer")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentinfomeldungen.Rows(i).Item("aktiv")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Restore Coldindex - Delete::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
Next i
Me.Errormessage = "171"
'L<>schen der neuen InfoEmpf<70>nger
Dim nn As Integer
nnr = 0
For i = 0 To Save_Dokumentinfomeldungen.Rows.Count - 1
If Save_Dokumentinfomeldungen.Rows(i).Item("dokumentinfomeldungnr") > nnr Then nnr = Save_Dokumentinfomeldungen.Rows(i).Item("dokumentinfomeldungnr")
Next
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentinfomeldungnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, nnr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@empfaenger", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
scmCmdToExecute.Parameters.Add(New SqlParameter("@meldungnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@beistatus", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Now))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 2))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
Throw New Exception("Dokument_Infoempf<EFBFBD>nger::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
Me.Errormessage = "172"
End Sub
Private Sub Restore_dokumentzuordnungen(ByVal Save_Dokumentzuordnungen As DataTable, ByVal dokumentid As String)
Me.Errormessage = "173"
'Sofern keine Notizen vorhanden sind, Sub verlassen
Dim i As Integer
Dim nnr As Long
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_Dokumentzuordnungen"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
'Restore der alten notizen
For i = 0 To Save_Dokumentzuordnungen.Rows.Count - 1
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid1", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentzuordnungen.Rows(i).Item("dokumentid1")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid2", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentzuordnungen.Rows(i).Item("dokumentid2")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentzuordnungnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentzuordnungen.Rows(i).Item("nreintrag")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentzuordnungen.Rows(i).Item("mutiert_am")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentzuordnungen.Rows(i).Item("mutierer")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@zuordnungnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentzuordnungen.Rows(i).Item("zuordnungnr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_Dokumentzuordnungen.Rows(i).Item("aktiv")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
Next
Me.Errormessage = "174"
'L<>schen der neuen Notizen
nnr = 0
For i = 0 To Save_Dokumentzuordnungen.Rows.Count - 1
If Save_Dokumentzuordnungen.Rows(i).Item("nreintrag") > nnr Then nnr = Save_Dokumentzuordnungen.Rows(i).Item("nreintrag")
Next
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid1", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid2", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentzuordnungnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, nnr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Now))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@zuordnungnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 2))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
Me.Errormessage = "175"
End Sub
Private Sub Restore_Dokumentfunktionen(ByVal Save_DokumentFunktionen As DataTable, ByVal dokumentid As String)
Me.Errormessage = "176"
'Sofern keine dokumentfunktionen vorhanden sind, Sub verlassen
Dim i As Integer
Dim nnr As Long
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_Dokumentfunktionen"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
'Restore der alten dokumentfunktionen
For i = 0 To Save_DokumentFunktionen.Rows.Count - 1
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_DokumentFunktionen.Rows(i).Item("dokumentid")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentfunktiongruppenr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_DokumentFunktionen.Rows(i).Item("dokumentfunktiongruppenr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_DokumentFunktionen.Rows(i).Item("mutiert_am")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_DokumentFunktionen.Rows(i).Item("mutierer")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Save_DokumentFunktionen.Rows(i).Item("aktiv")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
Next
Me.Errormessage = "177"
'L<>schen der neuen dokumentfunktionen
nnr = 0
For i = 0 To Save_DokumentFunktionen.Rows.Count - 1
If Save_DokumentFunktionen.Rows(i).Item("dokumentfunktiongruppenr") > nnr Then nnr = Save_DokumentFunktionen.Rows(i).Item("dokumentfunktiongruppenr")
Next
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentfunktiongruppenr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, nnr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Microsoft.VisualBasic.Now))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 2))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
Me.Errormessage = "178"
End Sub
Private Sub Restore_Statushistory(ByVal save_historystatus As Integer, ByVal dokumentid As String)
Me.Errormessage = "179"
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_statushistory"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@statushistorynr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_historystatus))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Restore Coldindex - Delete::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
End Try
Me.Errormessage = "180"
End Sub
Private Sub delete_dokumentstatus(ByVal dokumentid As String)
Me.Errormessage = "181"
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_delete_dokumentstatus"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Restore Coldindex - Delete::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
End Try
Me.Errormessage = "182"
End Sub
Private Sub Restore_Dokumentersetzen(ByVal save_dokumentersetzen As DataTable, ByVal dokumentid As String)
Me.Errormessage = "183"
'Sofern keine dokumentfunktionen vorhanden sind, Sub verlassen
Dim i As Integer
Dim nnr As Long
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_Dokumentersetzen"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
'Restore der alten dokumentfunktionen
For i = 0 To save_dokumentersetzen.Rows.Count - 1
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentersetzennr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_dokumentersetzen.Rows(i).Item("dokumentersetzennr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@hauptdokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.DokumentID))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_dokumentersetzen.Rows(i).Item("aktiv")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
Next
Me.Errormessage = "184"
'L<>schen der neuen dokumentfunktionen
nnr = 0
For i = 0 To save_dokumentersetzen.Rows.Count - 1
If save_dokumentersetzen.Rows(i).Item("dokumentersetzennr") > nnr Then nnr = save_dokumentersetzen.Rows(i).Item("dokumentersetzennr")
Next
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentersetzennr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, nnr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@hauptdokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 2))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
Me.Errormessage = "185"
End Sub
#End Region
#Region "TM-Pr<50>fung"
Dim ofile As System.IO.File
Dim oread As System.IO.TextWriter
'BUD - 2006-12-06 - AUSKommentiert
'Public Sub Check_Doks()
' oread = ofile.CreateText("c:\tm.txt")
' Dim dokt As New edokadb.clsDokumenttyp()
' dokt.cpMainConnectionProvider = conn
' 'conn.OpenConnection()
' Dim da As DataTable
' da = dokt.SelectAll()
' Dim a As Long
' a = InputBox("Ab Dokumenttypnr")
' Dim i As Integer
' For i = 0 To da.Rows.Count - 1
' If da.Rows(i).Item("aktiv") = True And da.Rows(i).Item("dokumenttypnr") > a And da.Rows(i).Item("Dokument_wird_erstellt") = True Then
' Me.Dokumenttypnr = da.Rows(i).Item("dokumenttypnr")
' oread.WriteLine("------->" + Str(da.Rows(i).Item("dokumenttypnr")) + " " + da.Rows(i).Item("bezeichnung"))
' oread.Flush()
' check_word()
' End If
' Next
' oread.Close()
'End Sub
'BUD - 2006-12-06 - AUSKommentiert
'Public Sub check_word()
' 'Office-Vorlage auslesen
' DokumenTtyp.cpMainConnectionProvider = conn
' DokumenTtyp.iDokumenttypnr = New SqlInt32(CType(Me.Dokumenttypnr, Int32))
' DokumenTtyp.SelectOne()
' Office_Vorlage.cpMainConnectionProvider = conn
' Office_Vorlage.iOffice_vorlagenr = DokumenTtyp.iOffice_vorlagenr
' Office_Vorlage.SelectOne()
' If Office_Vorlage.iAnwendungnr.Value = 2 Then
' Exit Sub
' End If
' 'Tempor<6F>r-Datei
' Dokument_Temp = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente")
' Dokument_Temp = Dokument_Temp + Office_Vorlage.sPrefix_dokumentname.Value + ".doc"
' 'Nativ-Dokumentvorlage
' If Not Office_Vorlage.bIdv_vorlage.Value = True Then
' Else
' Dokumentfilename = "c:\edokatemp\wordcheck.doc"
' Create_IDVDokument(Office_Vorlage.sIdv_id.Value)
' End If
' IsProtected = False
' If docWord.ProtectionType <> WdProtectionType.wdNoProtection Then
' docWord.Unprotect(password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_wordvorlagen"))
' IsProtected = True
' End If
' Dim i As Integer
' For i = 1 To docWord.Bookmarks.Count
' If InStr(docWord.Bookmarks.Item(i).Name, "Betreuer") > 0 Then
' oread.WriteLine(DokumenTtyp.sBezeichnung.Value + " - " + docWord.Bookmarks.Item(i).Name)
' End If
' Next
' docWord.Close()
' objWord.Quit()
' docWord = Nothing
' objWord = Nothing
'End Sub
#End Region
#Region "Etiketten"
Public Function Create_Labels()
StartWord()
docWord = objWord.Documents.Add
objWord.MailingLabel.DefaultPrintBarCode = False
objWord.MailingLabel.CreateNewDocument(Name:="Herma 4611", Address:="", AutoText:="")
objWord.Visible = True
docWord = Nothing
docWord = objWord.ActiveDocument
Dim bc As New edokadb.clsBarcodeetikette()
Dim i As Integer
Dim i1 As Integer
Dim keys As New edokadb.clsMyKey_Tabelle()
Dim key As Long
Dim defkey As String
Dim yy As String
i1 = 0
bc.cpMainConnectionProvider = conn
For i = 0 To 50
keys.cpMainConnectionProvider = conn
key = keys.get_dbkey("barcodeetikette")
defkey = LTrim(key)
While Len(defkey) < 7
defkey = "0" + defkey
End While
yy = LTrim(Str(Year(Now)))
yy = Right(yy, 2)
defkey = yy + defkey
defkey = defkey + LTrim(Pruefziffer(defkey))
bc.iBarcodenr = New SqlInt32(CType(defkey, Int32))
bc.sDokumentid = New SqlString(CType("", String))
bc.bAktiv = New SqlBoolean(CType(True, Boolean))
bc.daErstellt_am = New SqlDateTime(CType(Now, DateTime))
bc.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
bc.iMandantnr = New SqlInt32(CType(Globals.MandantNr, Int32))
bc.iMutierer = New SqlInt32(CType(Globals.MitarbeiterNr, Int32))
conn.OpenConnection()
bc.Insert()
conn.CloseConnection(True)
defkey = Bar25I(defkey)
objWord.Selection.TypeText(defkey)
objWord.Selection.HomeKey(Unit:=Word.WdUnits.wdLine, Extend:=Word.WdMovementType.wdExtend)
objWord.Selection.Font.Name = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("barcode_font")
objWord.Selection.Font.Size = 38
objWord.Selection.MoveRight(Unit:=Word.WdUnits.wdCharacter, Count:=1)
i1 = i1 + 1
If i1 = 3 Then
If i < 49 Then
objWord.Selection.MoveDown(Unit:=Word.WdUnits.wdLine, Count:=1)
objWord.Selection.MoveLeft(Unit:=Word.WdUnits.wdCharacter, Count:=2)
i1 = 0
End If
Else
objWord.Selection.MoveRight(Unit:=Word.WdUnits.wdCharacter, Count:=1)
End If
Next
objWord.Selection.PageSetup.TopMargin = 0
objWord.Selection.PageSetup.LeftMargin = 10
End Function
Public Function Pruefziffer(ByVal zahl As String) As String
Dim ptab(9, 9) As Integer
Dim pz(9) As Integer
Dim s1, s2, s3 As String
Dim i1, i2 As Long
s1 = "0,9,4,6,8,2,7,1,3,5"
s2 = s1
For i1 = 0 To 9
For i2 = 0 To 9
ptab(i1, i2) = Mid(s2, (i2 * 2) + 1, 1)
Next
s3 = Microsoft.VisualBasic.Left(s1, 1)
s1 = Microsoft.VisualBasic.Right(s1, Len(s1) - 2)
s1 = s1 + "," + s3
s2 = s1
Next
pz(0) = 0
pz(1) = 9
pz(2) = 8
pz(3) = 7
pz(4) = 6
pz(5) = 5
pz(6) = 4
pz(7) = 3
pz(8) = 2
pz(9) = 1
Dim i, x, y, z, e As Integer
Dim xx As String
y = 0
For i = 1 To Len(zahl)
x = Val(Mid(zahl, i, 1))
y = ptab(x, y)
Next
Pruefziffer = Str(pz(y))
End Function
#End Region
#Region "Enabel / Disable"
Public Sub Office_Freigeben(ByVal f As frmWaitforClosing)
Me.Errormessage = "186"
Try
'Me.StartWord()
Me.StartWord_New_Instance()
f.ProgressBar1.Value = 20
Disable_Enable_MenuFunctions(True)
f.ProgressBar1.Value = 30
'Rel 3.72
objWord.Application.Options.SaveInterval = 10
objWord.NormalTemplate.Saved = True
'objWord.Quit()
'objWord.Visible = True
f.ProgressBar1.Value = 40
objWord.Quit()
objWord = Nothing
Catch
End Try
Me.Errormessage = "187"
Try
f.ProgressBar1.Value = 50
StartExcel()
f.ProgressBar1.Value = 60
Disable_Enable_MenuFunctions_Excel(True)
f.ProgressBar1.Value = 70
'objExcel.Visible = True
f.ProgressBar1.Value = 80
'objExcel.Quit()
f.ProgressBar1.Value = 90
objExcel = Nothing
Catch
End Try
Me.Errormessage = "188"
End Sub
Private Sub Disable_Enable_FKeys(ByVal Enable As Boolean)
Try
'Rel(3.7 / BUD)
If Enable = False Then
'Org aus VB -> FindKey(BuildKeyCode(wdKeyF12)).Disable
Call objWord.FindKey(objWord.BuildKeyCode(WdKey.wdKeyF12)).Disable()
Dim cmdctrl As Object
Dim i As Integer
For i = 1 To objWord.KeyBindings.Count() 'objWord.CommandBars.FindControls("FileSaveAs")
Debug.Write(objWord.KeyBindings.Item(i).KeyCode())
Debug.Write(objWord.KeyBindings.Item(i).Command())
If objWord.KeyBindings.Item(i).Command = "FileSaveAs" Then
Call objWord.FindKey(objWord.KeyBindings.Item(i).KeyCode).Disable()
End If
Next
Else
'Org aus VB -> KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF12), KeyCategory:=wdKeyCategoryCommand, Command:="FileSaveAs"
Call objWord.KeyBindings.Add(WdKeyCategory.wdKeyCategoryCommand, "FileSaveAs", objWord.BuildKeyCode(WdKey.wdKeyF12))
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Public Sub Disable_Enable_MenuFunctions(ByVal Enable As Boolean)
Me.Errormessage = "189"
On Error Resume Next
Dim cmdctrl As Object
Dim i As Integer
On Error Resume Next
'Disable_Enable_FKeys(Enable)
' R<>cksetzen aller Commandbars aus Performancegr<67>nden deaktivieren
' SHU
' 2004-11-16
' For i = 1 To objWord.CommandBars.Count
' objWord.CommandBars(i).Reset()
' Next
For Each cmdctrl In objWord.CommandBars.FindControls(Id:=18)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objWord.CommandBars.FindControls(Id:=23)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objWord.CommandBars.FindControls(Id:=748)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objWord.CommandBars.FindControls(Id:=3823)
cmdctrl.enabled = Enable
Next cmdctrl
'senden an zulassen
If Me.DokumenTtyp.bEmail_versand.Value = True Then
For Each cmdctrl In objWord.CommandBars.FindControls(Id:=30095)
cmdctrl.enabled = True
Next cmdctrl
Else
For Each cmdctrl In objWord.CommandBars.FindControls(Id:=30095)
cmdctrl.enabled = Enable
Next cmdctrl
End If
' For Each cmdctrl In objWord.CommandBars.FindControls(ID:=30095)
' cmdctrl.enabled = Enable
' Next cmdctrl
For Each cmdctrl In objWord.CommandBars.FindControls(Id:=797)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objWord.CommandBars.FindControls(Id:=777)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objWord.CommandBars.FindControls(Id:=30017)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objWord.CommandBars.FindControls(Id:=30045)
cmdctrl.enabled = Enable
Next cmdctrl
' objWord.NormalTempslate.Saved = True
Me.Errormessage = "190"
End Sub
Public Function ResetFunctions()
Me.Errormessage = "191"
StartWord()
Disable_Enable_MenuFunctions(True)
objWord.NormalTemplate.Saved = True
objWord.Visible = True
Me.Errormessage = "192"
End Function
Public Sub Disable_Enable_MenuFunctions_Excel(ByVal Enable As Boolean)
Me.Errormessage = "193"
On Error Resume Next
Dim cmdctrl As Object
Dim i As Integer
On Error Resume Next
For i = 1 To objExcel.CommandBars.Count
objExcel.CommandBars(i).Reset()
Next
For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=18)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=23)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=748)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=3823)
cmdctrl.enabled = Enable
Next cmdctrl
'senden an zulassen
If Me.DokumenTtyp.bEmail_versand.Value = True Then
For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=30095)
cmdctrl.enabled = True
Next cmdctrl
Else
For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=30095)
cmdctrl.enabled = Enable
Next cmdctrl
End If
' For Each cmdctrl In objexcel.CommandBars.FindControls(ID:=30095)
' cmdctrl.enabled = Enable
' Next cmdctrl
For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=797)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=777)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=30017)
cmdctrl.enabled = Enable
Next cmdctrl
For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=30045)
cmdctrl.enabled = Enable
Next cmdctrl
'objExcel.NormalTemplate.Saved = True
Me.Errormessage = "194"
End Sub
Public Function ResetFunctions_Excel()
Me.Errormessage = "195"
StartExcel()
Disable_Enable_MenuFunctions_Excel(True)
objExcel.Visible = True
Me.Errormessage = "196"
End Function
#End Region
#Region "Leere Dokumente erstellen"
Public Sub Create_Empty_Doc(ByVal dokumenttypnr As Integer)
Me.Errormessage = "197"
DokumenTtyp.cpMainConnectionProvider = conn
DokumenTtyp.iDokumenttypnr = New SqlInt32(CType(dokumenttypnr, Int32))
DokumenTtyp.SelectOne()
Office_Vorlage.cpMainConnectionProvider = conn
Office_Vorlage.iOffice_vorlagenr = DokumenTtyp.iOffice_vorlagenr
Office_Vorlage.SelectOne()
If Office_Vorlage.iAnwendungnr.Value = 2 Then
Create_Excel_Doc(False, "")
Exit Sub
End If
'Nativ-Dokumentvorlage
If Not Office_Vorlage.bIdv_vorlage.Value = True Then
'Dokumenterstellung ab Datenbank
'SHU 20040301
Dim x As New FrmDomainOfficeVorlageDatei()
Dokument_To_Create = x.Get_From_DB(Me.Office_Vorlage.iOffice_vorlagenr.Value, Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente"))
StartWord()
Try
objWord.Documents.Add(Template:=Dokument_To_Create)
Catch ex As Exception
End Try
docWord = objWord.ActiveDocument
Try
objWord.NormalTemplate.Saved = True
Catch
End Try
x.Dispose()
objWord.Visible = True
docWord = objWord.ActiveDocument
docWord = Nothing
objWord = Nothing
Else
If Not OhneIDV Then
Create_IDV_Doc()
Else
StartWord()
objWord.Documents.Add(Template:=Dokument_To_Create)
docWord = objWord.ActiveDocument
docWord = Nothing
objWord = Nothing
End If
End If
Me.Errormessage = "198"
End Sub
Public Function Create_Empty_Doc_and_Save(ByVal dokumenttypnr As Integer, ByVal Filename As String) As Boolean
Me.Errormessage = "199"
Try
Office_Vorlage.cpMainConnectionProvider = conn
Office_Vorlage.iOffice_vorlagenr = New SqlInt32(CType(dokumenttypnr, Int32))
Office_Vorlage.SelectOne()
If Office_Vorlage.iAnwendungnr.Value = 2 Then
DokumenTtyp.iDokumenttypnr = New SqlInt32(CType(dokumenttypnr, Int32))
DokumenTtyp.cpMainConnectionProvider = conn
DokumenTtyp.SelectOne()
Create_Excel_Doc(True, Filename)
Exit Function
End If
StartWord()
Create_IDV_Doc()
docWord = objWord.ActiveDocument
docWord.SaveAs(Filename)
docWord.Close()
docWord = Nothing
objWord.Quit()
objWord = Nothing
Create_Empty_Doc_and_Save = True
Catch ex As Exception
TKBLib.Errorhandling.TraceHelper.Msg("WordLib.Create_Empty_Doc_and_Save.", ex.Message + " " + ex.StackTrace, TraceLevel.Warning)
MsgBox("Bei der Generierung des Dokumentes ist ein Fehler aufgetreten. Das Dokument wird nicht generiert." + vbNewLine + vbNewLine + ex.Message + ex.StackTrace, MsgBoxStyle.Critical)
Create_Empty_Doc_and_Save = False
Finally
Try
objWord.Quit()
objWord = Nothing
Catch
End Try
Me.Cancel_IDVPortfeuille_BackGround()
End Try
''Nativ-Dokumentvorlage
'If Not Office_Vorlage.bIdv_vorlage.Value = True Then
' StartWord()
' Dim x As New EDOKAApp.frmDomainOfficeVorlage()
' 'objWord.Documents.Add(x.Get_From_DB(Office_Vorlage.iOffice_vorlagenr.Value))
' docWord = objWord.ActiveDocument
' docWord.SaveAs(Filename)
' docWord.Close()
' docWord = Nothing
' objWord.Quit()
' objWord = Nothing
'Else
' If Not OhneIDV Then
' StartWord()
' Create_IDV_Doc()
' docWord = objWord.ActiveDocument
' docWord.SaveAs(Filename)
' docWord.Close()
' docWord = Nothing
' objWord.Quit()
' objWord = Nothing
' Else
' StartWord()
' objWord.Documents.Add(Template:=Dokument_To_Create)
' docWord = objWord.ActiveDocument
' docWord = Nothing
' objWord = Nothing
' End If
'End If
Me.Errormessage = "200"
End Function
Private Sub Create_IDV_Doc()
Me.Errormessage = "201"
Cancel_IDVPortfeuille()
m_objdc = CreateObject("DC.Application")
m_objdc.WindowState = DC.dcWindowState.dcActivated
Thread.Sleep(10)
Init_IDV_Variablen()
m_objdc.WindowState = DC.dcWindowState.dcActivated
If Not Office_Vorlage.bIdv_nativ.Value = True Then
m_objdc.WindowState = DC.dcWindowState.dcActivated
m_objdc.WordPlusDialog = DC.dcWordPlusDialogs.dcKein
m_objdc.DisableStandardMacros()
End If
If Office_Vorlage.bIdv_nativ.Value = True Then
m_objdc.CreateDocument(DC.dcModus.dcMTBS, CType(Office_Vorlage.sIdv_id.Value, Integer))
Else
m_objdc.CreateDocument(DC.dcModus.dcMTBS, CType(Office_Vorlage.sIdv_id.Value, Integer))
End If
'BUD - 06.12.2006 - ComObject
m_objdc.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(m_objdc)
m_objdc = Nothing
Me.Errormessage = "202"
End Sub
Private Sub Create_Excel_Doc(ByVal save As Boolean, ByVal filename As String)
Me.Errormessage = "203"
Dim i As Integer
Me.inEditMode = False
Me.Excel_Dokument = True
Office_Vorlage.cpMainConnectionProvider = conn
Office_Vorlage.iOffice_vorlagenr = DokumenTtyp.iOffice_vorlagenr
Office_Vorlage.SelectOne()
'Nativ-Dokumentvorlage
Dim abdatei As Boolean = False
If Office_Vorlage.sOffice_vorlage.Value Is System.DBNull.Value Then
abdatei = True
Else
If Office_Vorlage.sOffice_vorlage.Value = "" Then abdatei = True
End If
If abdatei Then
Dim x As New FrmDomainOfficeVorlageDatei()
Dokument_To_Create = x.Get_From_DB(Me.Office_Vorlage.iOffice_vorlagenr.Value, Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente"))
StartExcel()
Try
objExcel.Workbooks.Add(Template:=Dokument_To_Create)
Catch ex As Exception
End Try
docExcel = objExcel.ActiveWorkbook
x.Dispose()
Else
Dokument_To_Create = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_excel_vorlagen") + Office_Vorlage.sOffice_vorlage.Value
StartExcel()
objExcel.Workbooks.Add(Template:=Dokument_To_Create)
If save Then
objExcel.ActiveWorkbook.SaveAs(filename)
objExcel.ActiveWorkbook.Close()
objExcel.Quit()
Else
objExcel.Visible = True
End If
objExcel = Nothing
End If
Me.Errormessage = "204"
End Sub
Public Sub Cancel_IDVPortfeuille_BackGround()
Me.Errormessage = "205"
Dim hwnd As Long
hwnd = Win32API.FindWindow(vbNullString, "DC")
While hwnd <> 0
Dim myProcess() As Process
'Dim id As System.Diagnostics.Process
'Dim xxx As Long
Try
myProcess = Process.GetProcessesByName("DC")
'BUD - 2006-05-08 Fehler in Vista, IDVP kann nicht gekillt werden
'myProcess(0).Kill()
If myProcess(0).HasExited = False Then
If myProcess(0).CloseMainWindow() = False Then
Try
myProcess(0).Kill()
Catch
End Try
End If
End If
Thread.Sleep(500)
Catch
Finally
hwnd = Win32API.FindWindow(vbNullString, "DC")
End Try
End While
Me.Errormessage = "206"
End Sub
#End Region
'Rel. 4.03
Public Sub Try_Show_Office_Object()
Try
objWord.Visible = True
Catch ex As Exception
StartWord()
objWord.Visible = True
End Try
Try
objExcel.Visible = True
Catch ex As Exception
End Try
End Sub
End Class
Reference in new issue View Git Blame Copy Permalink