Imports System.IO Imports System.Security.AccessControl Imports System.Security.Principal Imports System.Data.SqlClient Imports Oracle.ManagedDataAccess.Client Imports DD_LIB_Standards Public Class frmWD_IndexFile Dim droptype As String Dim aktFiledropped As String Dim MULTIFILES As Integer = 0 Dim formloaded As Boolean = False Function WORK_FILE(ImportFilePath As String, VerzeichnisZiel As String, vDokart_ID As Integer, vDokart As String, multiindex As Boolean) Try CURRENT_DOKARTSTRING = vDokart Dim err As Boolean = False '################################################################# 'Name und ZielPfad generieren '################################################################# If ClassImport_Windream.Name_Generieren(DOCTYPE_IDTextBox.Text) = False Then Return False End If If clsWD_GET.WDFile_exists(CURRENT_NEWFILENAME.Substring(2)) = True Then Dim msg = "Eine Datei mit identischem Namen existiert bereits! Wollen Sie die bestehende Datei ersetzen?" If USER_LANGUAGE <> "de-DE" Then msg = "There is already a file with the same name! Would You like to replace the file?" End If Dim result As MsgBoxResult result = MessageBox.Show(msg, "File alredy exists:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then If clsWD_SET.Delete_WDFile(CURRENT_NEWFILENAME.Substring(2)) = False Then Return False End If Else CURRENT_NEWFILENAME = ClassHelper.Versionierung_Datei(CURRENT_NEWFILENAME) End If End If '################################################################# 'Stream File to windream '################################################################# Dim streamresult = clsWD_SET.Stream_File(ImportFilePath, CURRENT_NEWFILENAME, False) '################################################################# If streamresult = True Then CURRENT_FILEIN_WD = CURRENT_NEWFILENAME Dim sql = "SELECT * FROM TBDD_INDEX_AUTOM WHERE ACTIVE = 1 AND UPPER(INDEXNAME) NOT LIKE UPPER('%ONLY %') AND SQL_ACTIVE = 0 AND DOCTYPE_ID = " & vDokart_ID Dim DT_AUTO_INDEXE As DataTable = ClassDatabase.Return_Datatable(sql, True) Dim indexierung_erfolgreich As Boolean = True 'Erst die Objekttyp-Indices indexieren 'den Entity-Key auslesen Dim DT As DataTable sql = "Select Top 1 * from TBPMO_WD_OBJECTTYPE where Upper(object_type) = Upper('" & clsWindream.MY_WDOBJECTTYPE & "')" DT = ClassDatabase.Return_Datatable(sql, True) If Not DT Is Nothing Then If DT.Rows.Count = 1 Then 'den Record_Key auslesen Dim indexname = DT.Rows(0).Item("IDXNAME_RECORDID").ToString If LogErrorsOnly = False Then ClassLogger.Add(" >> Record-ID: " & CURRENT_RECORD_ID.ToString, False) indexierung_erfolgreich = clsWD_SET.IndexFile(CURRENT_FILEIN_WD, indexname, CURRENT_RECORD_ID, clsWindream.MY_WDOBJECTTYPE) If indexierung_erfolgreich = False Then err = True ClassHelper.MSGBOX_Handler("ERROR", "Unexpected Error: ", "Unexpected Error in WorkFile-indexing RecordID '" & indexname & "') - Check logfile!") Return False End If 'den Entity-Key auslesen indexname = DT.Rows(0).Item("IDXNAME_ENTITYID").ToString If LogErrorsOnly = False Then ClassLogger.Add(" >> Entity-ID: " & CURRENT_ENTITY_ID.ToString, False) indexierung_erfolgreich = clsWD_SET.IndexFile(CURRENT_FILEIN_WD, indexname, CURRENT_ENTITY_ID, clsWindream.MY_WDOBJECTTYPE) If indexierung_erfolgreich = False Then err = True ClassHelper.MSGBOX_Handler("ERROR", "Unexpected Error: ", "Unexpected Error in WorkFile-indexing EntityID '" & indexname & "') - Check logfile!") Return False End If If CURRENT_REDUNDANT_FORM_ID <> 0 Then indexierung_erfolgreich = clsWD_SET.IndexFile(CURRENT_FILEIN_WD, indexname, CURRENT_REDUNDANT_FORM_ID, clsWindream.MY_WDOBJECTTYPE) End If 'den Doctype auslesen indexname = DT.Rows(0).Item("IDXNAME_DOCTYPE").ToString If LogErrorsOnly = False Then ClassLogger.Add(" >> Doctype: " & vDokart.ToString, False) indexierung_erfolgreich = clsWD_SET.IndexFile(CURRENT_FILEIN_WD, indexname, vDokart, clsWindream.MY_WDOBJECTTYPE) If indexierung_erfolgreich = False Then err = True ClassHelper.MSGBOX_Handler("ERROR", "Unexpected Error: ", "Unexpected Error in WorkFile-indexing Doctype '" & indexname & "') - Check logfile!") Return False End If indexname = DT.Rows(0).Item("IDXNAME_RELATION").ToString indexierung_erfolgreich = clsWD_SET.IndexFile(CURRENT_FILEIN_WD, indexname, "ADDI-RELATION", clsWindream.MY_WDOBJECTTYPE) If indexierung_erfolgreich = False Then err = True ClassHelper.MSGBOX_Handler("ERROR", "Unexpected Error: ", "Unexpected Error in WorkFile-indexing AddiRelation '" & indexname & "') - Check logfile!") Return False End If End If End If If DT_AUTO_INDEXE Is Nothing = False Then 'CHECK DD If DT_AUTO_INDEXE.Rows.Count > 0 Then Dim Count As Integer = 0 For Each row As DataRow In DT_AUTO_INDEXE.Rows Dim indexname = row.Item("INDEXNAME").ToString Dim idxvalue = row.Item("VALUE") If idxvalue.ToString.StartsWith("@") Then Select Case idxvalue.ToString.ToUpper Case "@RECORD-ID" idxvalue = idxvalue.ToString.Replace("@Record-ID", CURRENT_RECORD_ID) Case "@DOKART" idxvalue = idxvalue.ToString.Replace("@Dokart", vDokart) End Select Else 'Es wird nicht über einen @PAttern indexiert ' Regulären Ausdruck zum Auslesen der Indexe definieren Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' einen Regulären Ausdruck laden Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) ' die Vorkommen im SQL-String auslesen Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(idxvalue) '#### ' alle Vorkommen innerhalbd er Namenkonvention durchlaufen For Each element As System.Text.RegularExpressions.Match In elemente If LogErrorsOnly = False Then ClassLogger.Add(" >> element in RegeX: " & element.Value, False) Select Case element.Value.Substring(2, 1).ToUpper 'Nur automatische Indizes auswerten Case "A" Dim APattern = element.Value.Substring(3, element.Value.Length - 4) If APattern.Contains("#") Then If LogErrorsOnly = False Then ClassLogger.Add(" >> element filled with Record-Data.......: ", False) Dim split() As String = APattern.Split("#") If split.Length = 2 Then Dim CONTROL_ID = split(1) If LogErrorsOnly = False Then ClassLogger.Add(" >> CONTROL_ID: " & CONTROL_ID, False) If IsNumeric(CONTROL_ID) Then Dim CONTROLVALUE = ClassControlValues.Get_Control_Value_for_ID(CONTROL_ID, CURRENT_RECORD_ID) If IsNothing(CONTROLVALUE) Then ClassLogger.Add(">> Index should be filled with value of Control-ID '" & CONTROL_ID & "', but result was nothing.", False) ClassLogger.Add(">> SQL-Command: " & CURRENT_LAST_SQL) idxvalue = "" Else If IsDBNull(CONTROLVALUE) Then ClassLogger.Add(">> Index should be filled with value of Control-ID '" & CONTROL_ID & "', but result was DBNULL.", False) ClassLogger.Add(">> SQL-Command: " & CURRENT_LAST_SQL) idxvalue = "" Else idxvalue = CONTROLVALUE End If End If Else End If End If End If End Select Next End If If LogErrorsOnly = False Then ClassLogger.Add(" >> Value for Indexing : '" & idxvalue.ToString & "'", False) Count += 1 indexierung_erfolgreich = clsWD_SET.IndexFile(CURRENT_FILEIN_WD, indexname, idxvalue, clsWindream.MY_WDOBJECTTYPE) If indexierung_erfolgreich = False Then MsgBox("Unexpected Error in indexing file - See log", MsgBoxStyle.Critical) err = True Exit For End If 'ByVal WD_File As String, ByVal _Indexname As String, ByVal _Value As String Next If err = True Then Return False End If Else 'MsgBox("Attention in Work-File:" & vbNewLine & "No indices were defined (1)!", MsgBoxStyle.Critical) 'Return False End If Else MsgBox("Attention in Work-File:" & vbNewLine & "No indices were defined (0)!", MsgBoxStyle.Critical) Return False End If 'Nun alles aufrüumen und die neue DocID holen If indexierung_erfolgreich = True Then ClassLogger.Add(">> File was correctly imported and indexed: " & CURRENT_FILEIN_WD, False) Dim stg As String = "Datei erfolgreich nach windream übertragen" Dim stg1 As String = "Erfolgsmeldung" If USER_LANGUAGE <> "de-DE" Then stg = "File was successfully transfered to windream" stg1 = "Success:" End If If multiindex = False Then CURRENT_NOTIFICATION_MSG = stg ClassDatabase.Execute_Scalar("UPDATE TBPMO_FILES_USER SET WORKED = 1 WHERE GUID = " & CURRENT_FILEID, True) For Each row As DataRow In CURRENT_TBPMO_FILES_USER.Rows If row.Item("GUID") = CURRENT_FILEID Then row.Item("WORKED") = 1 If IsNothing(droptype) Then droptype = row.Item("HANDLE_TYPE") End If End If Next sql = String.Format("SELECT DocID FROM VWPMO_DOC_SYNC WHERE UPPER(FULL_FILENAME) = UPPER('{0}') AND CONVERT(DATE,Change_DateTime) = CONVERT(DATE,GETDATE())", CURRENT_FILEIN_WD) CURRENT_DOC_ID = ClassDatabase.Execute_Scalar(sql) If Not IsNothing(CURRENT_DOC_ID) Then ClassLogger.Add(String.Format(">> File-Import was finished - DocID: {0} ", CURRENT_DOC_ID), False) Dim delete = False 'Die Originaldatei löschen If droptype = "dragdrop file" And indexierung_erfolgreich = True Then If chkdelete_origin.Checked = True Then 'Die temporäre Datei löschen File.Delete(aktFiledropped) End If ElseIf (droptype = "@ATTMNTEXTRACTED@" Or droptype = "SCAN") And indexierung_erfolgreich = True Then 'Die temporäre Datei löschen delete = True ElseIf droptype = "dragdrop message" And indexierung_erfolgreich = True Then 'Die temporäre Datei löschen delete = True End If If delete = True Then For Each row As DataRow In CURRENT_TBPMO_FILES_USER.Rows If row.Item("GUID") = CURRENT_FILEID Then row.Item("DELETE_FILE") = True End If Next End If If clsWindream.Create_Session() = False Then MsgBox("Could not create a windream-session!", MsgBoxStyle.Critical) Else 'Create Session um Fehler bei windows Session nicht zu erzeugen FAU_AD_USER = "" ClassFileResult.DocID = CURRENT_DOC_ID ClassFileResult.SET_DOCID_INDICES() If ClassDOC_SEARCH.CREATE_DOC_RELATED_LINKS(CURRENT_DOC_ID, CURRENT_RECORD_ID) = False Then stg = "Unerwarteter Fehler: Der Record-Link konnte nicht erzeugt werden! Überprüfen Sie das Log." If USER_LANGUAGE <> "de-DE" Then stg = "Unexpected Error: Could not create the recordlink! Please check the log." End If MsgBox(stg, MsgBoxStyle.Critical, stg1) Else 'If CURRENT_REDUNDANT_FORM_ID <> 0 Then ' ClassDOC_SEARCH.SET_WD_RIGHTS(CURRENT_DOC_ID, CURRENT_FILEIN_WD) 'End If If ClassDOC_SEARCH.SET_WD_RIGHTS(CURRENT_DOC_ID, CURRENT_FILEIN_WD) = False Then MsgBox("The rights for the new file could not be created! Please check the logfile!" & vbNewLine & _ "ADDI will try to give You at least reading rights!", MsgBoxStyle.Exclamation) DD_Rights.ClassRights.SetRightExplicit(CURRENT_DOC_ID, CURRENT_FILEIN_WD, USER_USERNAME, 1) ClassHelper.InsertEssential_Log(CURRENT_DOC_ID, "DOC-ID", "NEW FILE INDEXING - RIGHTS COULD NOT BE SET!!") End If End If End If Else stg = "Unerwarteter Fehler: Es konnte keine DocID für die übertragene Datei erzeugt werden!" If USER_LANGUAGE <> "de-DE" Then stg = "Unexpected Error: Could not get a docId for transmitted file!" End If MsgBox(stg, MsgBoxStyle.Critical, stg1) End If Else MsgBox("An unexpected error occured while indexing file. Please check the log!", MsgBoxStyle.Exclamation) Return False End If Return True Else Return False End If Catch ex As Exception MsgBox("Unexpected error in Work-File:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function 'Function FillIndexe_Autom(dokart_id As Integer) ' Try ' Me.VWDDINDEX_AUTOMTableAdapter.Fill(Me.DD_DMSDataSet.VWDDINDEX_AUTOM, dokart_id) ' If DD_DMSDataSet.VWDDINDEX_AUTOM.Rows.Count > 0 Then ' ' MsgBox(DT.Rows.Count.ToString) ' For Each DR_AUTOINDEX As DataRow In DD_DMSDataSet.VWDDINDEX_AUTOM.Rows ' Dim indexname As String = DR_AUTOINDEX.Item("INDEXNAME") ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Build Automatischer Index '" & indexname & "'", False) ' If DR_AUTOINDEX.Item("SQL_RESULT").ToString <> String.Empty And CBool(DR_AUTOINDEX.Item("SQL_ACTIVE")) = True Then ' ' Regulären Ausdruck zum Auslesen der windream-Indexe definieren ' Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' ' SQL-String für aktuellen INdex laden ' Dim SqlString As String = DR_AUTOINDEX.Item("SQL_RESULT") ' ' einen Regulären Ausdruck laden ' Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) ' ' die Vorkommen im SQL-String auslesen ' Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(SqlString) ' ' alle Vorkommen der Indexe im SQL-String durchlaufen ' For Each element As System.Text.RegularExpressions.Match In elemente ' ' MsgBox(element.Value.ToUpper) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Element: '" & element.Value & "'", False) ' '' wenn es sich nicht um dedizeirte Werte handelt (es sollen ja nur die Indexe ausgelesen werden) ' 'If Not element.Value.ToUpper = "[%SPALTE]" And Not element.Value.ToUpper = "[%VIEW]" Then ' 'die Zeichen [% und ] entfernen (liefert den wirklichen windream-Index) ' Dim elementOhneSonderzeichen As String = element.Value.Substring(2, element.Value.Length - 3) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> elementOhneSonderzeichen: '" & elementOhneSonderzeichen & "'", False) ' 'den Platzhalter im SQL-String durch den Wert ersetzen ' Dim manIndexwert As String = GetManIndex_Value(elementOhneSonderzeichen, "IDX_AUTO") ' If manIndexwert <> "" Then ' SqlString = SqlString.Replace(element.Value, manIndexwert) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> zusammengesetzter SQL-String: " & SqlString, False) ' Else ' ClassLogger.Add(" - ACHTUNG: manIndexwert = String.Empty - Funktion: FillIndexe_Autom", False) ' Return False ' End If ' Next ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Ausführen SQL....", False) ' Dim automatischerValue As String = "" ' automatischerValue = Get_AutomatischerIndex_SQL(SqlString, DR_AUTOINDEX.Item("CONNECTION_ID"), DR_AUTOINDEX.Item("SQL_PROVIDER")) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Ergebnis SQL: '" & automatischerValue & "'", False) ' If automatischerValue <> String.Empty Then ' DR_AUTOINDEX.Item("Indexiert") = True ' DR_AUTOINDEX.Item("Indexwert") = automatischerValue ' Else ' ClassLogger.Add(" - ACHTUNG: automatischerValue = String.Empty - Funktion: FillIndexe_Autom", False) ' ClassLogger.Add(" - SqlString: " & SqlString, False) ' Return False ' End If ' Else ' If Not IsDBNull(DR_AUTOINDEX.Item("VALUE")) Then ' If DR_AUTOINDEX.Item("VALUE") <> "" Then ' Dim DEFAULTVALUE As String = DR_AUTOINDEX.Item("VALUE") ' 'Indexierung mit WindowsVariable ' If DEFAULTVALUE.StartsWith("$") Then ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexierung mit einer Windowsvariable: '" & DEFAULTVALUE & "'", False) ' Select Case DEFAULTVALUE.ToUpper ' Case "$filename_ext".ToUpper ' DEFAULTVALUE = Path.GetFileName(CURRENT_WORKFILE) ' Case "$filename".ToUpper ' DEFAULTVALUE = Path.GetFileNameWithoutExtension(CURRENT_WORKFILE) ' Case "$FileCreateDate".ToUpper ' Dim FI As New FileInfo(CURRENT_WORKFILE) ' Dim CreationDate As Date = FI.CreationTime ' DEFAULTVALUE = CreationDate.ToShortDateString ' Case "$FileCreatedWho".ToUpper ' Dim fs As FileSecurity = File.GetAccessControl(CURRENT_WORKFILE) ' Dim sid As IdentityReference = fs.GetOwner(GetType(SecurityIdentifier)) ' Dim ntaccount As IdentityReference = sid.Translate(GetType(NTAccount)) ' Dim owner As String = ntaccount.ToString() ' DEFAULTVALUE = owner ' Case "$DateDDMMYYY".ToUpper ' DEFAULTVALUE = System.DateTime.Now.ToShortDateString ' End Select ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Ergebnis der Windowsvariable: '" & DEFAULTVALUE & "'", False) ' Else ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexierung mit einem Festen Wert: '" & DEFAULTVALUE & "'", False) ' End If ' 'Den Wert in der Zwischentabelle speichern ' DR_AUTOINDEX.Item("Indexiert") = True ' DR_AUTOINDEX.Item("Indexwert") = DEFAULTVALUE ' End If ' End If ' End If ' Next ' 'MsgBox("Noch kein automatischer Index-SQL-String hinterlegt, dennoch wird das Dokument abgelegt!") ' Return True ' Else ' Return True ' End If ' Catch ex As System.Exception ' ClassLogger.Add(" - Fehler bei FillIndexe_Autom - Fehler: " & vbNewLine & ex.Message) ' MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei FillIndexe_Autom") ' Return False ' End Try 'End Function Private Sub btnindex_Click(sender As Object, e As EventArgs) Handles btnindex.Click Try If CURRENT_RECORD_ID = 0 Then MsgBox("No Record chosen or the documenttype was not chosen!", MsgBoxStyle.Information) Exit Sub End If 'If lvwIndices.Items.Count = 0 Then ' MsgBox("Please choose a documenttxpe!", MsgBoxStyle.Information) ' Exit Sub 'End If If Not IsNothing(CURRENT_TBPMO_INDEX_MAN) Then If CURRENT_TBPMO_INDEX_MAN.Rows.Count > 0 Then If ClassFileResult.CheckWrite_IndexeMan(grbxControls) = False Then Exit Sub End If End If End If If cmbDokumentart.SelectedIndex <> -1 Then My.Settings.WD_INDEXDOKART_SAVE = cmbDokumentart.Text My.Settings.Save() Handle_File(cmbDokumentart.SelectedValue) End If Catch ex As Exception MsgBox("Unexpected Error in Prepare indexing: " & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Handle_File(doctype_id As Integer) Try Me.Cursor = Cursors.WaitCursor SaveMySettingsValue("WD_IndexDeleteDocs", WD_IndexDeleteDocs, "ConfigMain") clsWindream.MY_WDOBJECTTYPE = Me.OBJECT_TYPETextBox.Text If chkMultiIndexer.Visible = True And chkMultiIndexer.Checked = True Then 'Die erste Datei indexieren If WORK_FILE(Me.txtFilepath.Text, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, True) = True Then 'Und nun die folgenden Dim DTFiles2Work As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBPMO_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_FILEID & " AND UPPER(USER_WORK) = UPPER('" & USER_USERNAME & "')", True) If Not DTFiles2Work Is Nothing Then Dim err = False For Each filerow As DataRow In DTFiles2Work.Rows CURRENT_FILEID = filerow.Item("GUID") CURRENT_FILENAME = filerow.Item("FILENAME2WORK") Dim HandleType As String = filerow.Item("HANDLE_TYPE") aktFiledropped = CURRENT_FILENAME If HandleType = "@DROPFROMFSYSTEM@" Then droptype = "dragdrop file" ElseIf HandleType = "@OUTLOOK_ATTMNT@" Then droptype = "dragdrop attachment" ElseIf HandleType = "@OUTLOOKMESSAGE@" Then droptype = "dragdrop message" Else droptype = filerow.Item("HANDLE_TYPE") End If If WORK_FILE(CURRENT_FILENAME, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, True) = False Then err = True Exit For End If Next Me.Cursor = Cursors.Default If err = False Then NEW_FILES_ADDED = True Dim stg As String = "Alle Dateien wurden mit Multiindexing erfolgreich nach windream übertragen!" Dim stg1 As String = "Erfolgsmeldung" If USER_LANGUAGE <> "de-DE" Then stg = "All files were transferred via Multiindexing to windream" stg1 = "Success:" End If MsgBox(stg, MsgBoxStyle.Information, stg1) Me.Close() End If End If End If Else 'No MULTI INDEX If WORK_FILE(Me.txtFilepath.Text, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, False) = True Then NEW_FILES_ADDED = True Me.Close() Else MessageBox.Show("Import to windream was not successful." & vbNewLine & "Check the log for further information!", "Unexpected Error in windream-Stream:", MessageBoxButtons.OK, MessageBoxIcon.Error) End If End If Me.Cursor = Cursors.Default Catch ex As Exception MsgBox("Error in Indexing_File:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub cmbDokumentart_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbDokumentart.SelectedIndexChanged Try CURRENT_DOKARTID = 0 If cmbDokumentart.SelectedIndex <> -1 Then CURRENT_DOKARTID = cmbDokumentart.SelectedValue CURRENT_DOKARTSTRING = cmbDokumentart.Text Refresh_indices() Refresh_Indices_Manual() Check_Subfolder() End If Catch ex As Exception MsgBox("Error in cmbDokumentart SelectedIndex:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Refresh_Indices_Manual() Try ClassFileResult.GET_DATATABLE_INDICES_PMO() If CURRENT_TBPMO_INDEX_MAN.Rows.Count > 0 Then 'Der Tabelle eine Splate für den idnexwert hinzufügen Dim MAN_VALUE As DataColumn = CURRENT_TBPMO_INDEX_MAN.Columns.Add("MAN_VALUE", Type.GetType("System.String")) grbxControls.Visible = True grbxControls.Controls.Clear() Me.Size = New Size(605, 700) Dim anz As Integer = 1 Dim ylbl As Integer = 20 Dim y As Integer = 38 For Each DR As DataRow In CURRENT_TBPMO_INDEX_MAN.Rows Dim type = DR.Item("DATATYPE") If type <> "BOOLEAN" Then addLabel(DR.Item("GUID"), DR.Item("NAME"), DR.Item("COMMENT").ToString, ylbl) End If Dim DefaultValue = DR.Item("DEFAULT_VALUE") Select Case type Case "BOOLEAN" Dim VORBELGUNG As Integer = DefaultValue 'nur eine Textbox Dim chk As CheckBox = ClassControls_Manual.AddCheckBox(DR.Item("GUID"), DR.Item("NAME"), y, VORBELGUNG, DR.Item("COMMENT").ToString) If Not IsNothing(chk) Then grbxControls.Controls.Add(chk) End If Case "INTEGER" If DR.Item("SUGGESTION") = True And DR.Item("SQL_RESULT").ToString.Length > 0 Then AddVorschlag_ComboBox(DR.Item("GUID"), DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue) 'AddAutoSuggest_Textbox(DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue) Else Dim VORBELGUNG As Integer = DefaultValue 'nur eine Textbox AddTextBox(DR.Item("GUID"), DR.Item("NAME"), y, VORBELGUNG) End If Case "VARCHAR" If DR.Item("SUGGESTION") = True And DR.Item("SQL_RESULT").ToString.Length > 0 Then AddVorschlag_ComboBox(DR.Item("GUID"), DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue) 'AddAutoSuggest_Textbox(DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue) Else If DR.Item("NAME").ToString.ToLower = "dateiname" Then 'Übergibt den Dateinamen um diesen Vorzuschlagen AddTextBox(DR.Item("GUID"), DR.Item("NAME"), y, System.IO.Path.GetFileNameWithoutExtension(txtFilepath.Text)) Else Dim VORBELGUNG As String = DefaultValue 'nur eine Textbox AddTextBox(DR.Item("GUID"), DR.Item("NAME"), y, VORBELGUNG) End If End If Case "DATE" AddDateTimePicker(DR.Item("GUID"), DR.Item("NAME"), y) Case Else MsgBox("Bitte überprüfen Sie den Datentyp des hinterlegten Indexwertes!", MsgBoxStyle.Critical, "Achtung:") ClassLogger.Add(" - Datentyp nicht hinterlegt - LoadIndexe_Man") End Select anz += 1 ylbl += 60 y += 60 Next SendKeys.Send("{TAB}") Else grbxControls.Visible = False Me.Size = New Size(605, 430) End If Catch ex As Exception MsgBox("Error in Refresh_Indices_Manual:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Check_Subfolder() Try Dim sel If CURRENT_REDUNDANT_FORM_ID <> 0 Then sel = "select MANUAL_SUBFOLDER FROM TBPMO_WD_FORMVIEW_DOKTYPES WHERE FORMVIEW_ID = (SELECT GUID FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_REDUNDANT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID & ")" Else sel = "select MANUAL_SUBFOLDER FROM TBPMO_WD_FORMVIEW_DOKTYPES WHERE FORMVIEW_ID = (SELECT GUID FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_ENTITY_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID & ")" End If Dim chk = ClassDatabase.Execute_Scalar(sel, True) If Not IsNothing(chk) Then If CBool(chk) = True Then lblSubfolder.Visible = True txtSubfolder.Visible = True CURRENT_CHECK_SUBFOLDER = True CURRENT_SUBFOLDER = "" Else lblSubfolder.Visible = False txtSubfolder.Visible = False CURRENT_CHECK_SUBFOLDER = False End If End If Catch ex As Exception MsgBox("Error in Check_Subfolder:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) lblSubfolder.Visible = False txtSubfolder.Visible = False CURRENT_CHECK_SUBFOLDER = False End Try End Sub Sub addLabel(ID As Integer, indexname As String, hinweis As String, ylbl As Integer) Dim lbl As New Label lbl.Name = "lbl" & indexname lbl.Size = New Size(CInt(hinweis.Length * 15), 18) 'CInt(hinweis.Length * 9) lbl.Text = hinweis lbl.Tag = ID grbxControls.Controls.Add(lbl) lbl.Location = New Point(11, ylbl) End Sub Sub AddComboBoxValue(cmbName As ComboBox, Value As String) cmbName.Items.Add(Value) End Sub ' _ Function addCombobox(ID As Integer, indexname As String, y As Integer) Dim cmb As New ComboBox cmb.Name = "cmb" & indexname cmb.AutoSize = True cmb.Size = New Size(300, 27) cmb.Tag = ID grbxControls.Controls.Add(cmb) cmb.Location = New Point(11, y) 'cmb.AutoCompleteMode = AutoCompleteMode.SuggestAppend 'cmb.AutoCompleteSource = AutoCompleteSource.ListItems 'AddHandler cmb.KeyUp, AddressOf AutoCompleteCombo_KeyUp AddHandler cmb.SelectedIndexChanged, AddressOf OncmbSIndexChanged AddHandler cmb.GotFocus, AddressOf OncmbGotFocus AddHandler cmb.LostFocus, AddressOf OncmbLostFocus Return cmb End Function Public Sub OncmbGotFocus(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender cmb.BackColor = Color.Lime End Sub ' _ Public Sub OncmbLostFocus(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender cmb.BackColor = Color.White End Sub Function AddTextBox(ID As Integer, indexname As String, y As Integer, text As String) Dim txt As New TextBox txt.Name = "txt" & indexname txt.Size = New Size(260, 27) 'txt.AutoSize = True txt.Tag = ID grbxControls.Controls.Add(txt) txt.Location = New Point(11, y) If text <> "" Then txt.Text = text txt.Size = New Size(CInt(text.Length * 15), 27) txt.SelectAll() End If AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp AddHandler txt.TextChanged, AddressOf OnTextBoxTextChanged Return txt End Function Public Sub OnTextBoxFocus(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender box.BackColor = Color.Lime box.SelectAll() End Sub Public Sub OnTextBoxTextChanged(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender 'If box.Text.Length > 15 Then Dim g As Graphics = box.CreateGraphics box.Width = g.MeasureString(box.Text, box.Font).Width + 15 g.Dispose() ' End If End Sub Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender box.BackColor = Color.White End Sub Public Sub OnTextBoxKeyUp(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Dim box As TextBox = sender If (e.KeyCode = Keys.Return) Then SendKeys.Send("{TAB}") End If End Sub Sub AddDateTimePicker(ID As Integer, indexname As String, y As Integer) Dim dtp As New DateTimePicker dtp.Name = "dtp" & indexname dtp.Format = DateTimePickerFormat.Short dtp.Size = New Size(133, 27) dtp.Tag = ID dtp.Location = New Point(11, y) grbxControls.Controls.Add(dtp) AddHandler dtp.ValueChanged, AddressOf OndtpChanged End Sub Sub OndtpChanged() 'offen was hier zu tun ist End Sub Public Sub OncmbSIndexChanged(sender As System.Object, e As System.EventArgs) If formloaded = False Then Exit Sub End If Dim cmb As ComboBox = sender If cmb.SelectedIndex <> -1 Then If cmb.Text.Length > 15 Then Dim g As Graphics = cmb.CreateGraphics cmb.Width = g.MeasureString(cmb.Text, cmb.Font).Width + 30 g.Dispose() End If Get_NextComboBoxResults(cmb) SendKeys.Send("{TAB}") End If End Sub Sub Get_NextComboBoxResults(cmb As ComboBox) Try Dim indexname = cmb.Name.Replace("cmb", "") Dim sql = "SELECT GUID,NAME,SQL_RESULT FROM TBPMO_INDEX_MAN where SUGGESTION = 1 AND SQL_RESULT like '%@" & indexname & "%' and DOCTYPE_ID = " & CURRENT_DOKARTID & " ORDER BY SEQUENCE" Dim DT As DataTable = ClassDatabase.Return_Datatable(sql) If Not IsNothing(DT) Then If DT.Rows.Count > 0 Then Dim cmbname = "cmb" & DT.Rows(0).Item("NAME") Renew_ComboboxResults(DT.Rows(0).Item("GUID"), indexname, cmb.Text) End If End If Catch ex As Exception MsgBox("Error in Get_NextComboBoxResults:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub Renew_ComboboxResults(INDEX_GUID As Integer, SearchString As String, Resultvalue As String) Try Dim connectionString As String Dim sqlCnn As SqlConnection Dim sqlCmd As SqlCommand Dim adapter As New SqlDataAdapter Dim oracleConn As OracleConnection Dim oracleCmd As OracleCommand Dim oracleadapter As New OracleDataAdapter Dim NewDataset As New DataSet Dim i As Integer 'Dim DT_INDEX As DataTable = ClassDatabase.Return_Datatable("select * FROM TBPMO_INDEX_MAN WHERE GUID = " & INDEX_GUID, True) 'If IsNothing(DT_INDEX) Then ' Exit Sub 'End If Dim conid = ClassMoreMetadata.Return_CURRENT_TBPMO_INDEX_MAN_VALUE(INDEX_GUID, "CONNECTION_ID") ' DT_INDEX.Rows(0).Item("CONNECTION_ID") Dim sql_result = ClassMoreMetadata.Return_CURRENT_TBPMO_INDEX_MAN_VALUE(INDEX_GUID, "SQL_RESULT") 'DT_INDEX.Rows(0).Item("SQL_RESULT") Dim NAME = ClassMoreMetadata.Return_CURRENT_TBPMO_INDEX_MAN_VALUE(INDEX_GUID, "NAME") 'DT_INDEX.Rows(0).Item("NAME") If Not IsNothing(conid) And Not IsNothing(sql_result) And Not IsNothing(NAME) Then For Each ctrl As Control In Me.grbxControls.Controls If ctrl.Name = "cmb" & NAME.ToString Then Dim cmb As ComboBox = ctrl Dim sql As String = sql_result.ToString.ToUpper.Replace("@" & SearchString.ToUpper, Resultvalue) connectionString = ClassDatabase.GetConnectionString(conid) If connectionString Is Nothing = False Then 'SQL Befehl füllt die Auswahlliste If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then sqlCnn = New SqlConnection(connectionString) sqlCnn.Open() sqlCmd = New SqlCommand(sql, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then oracleConn = New OracleConnection(connectionString) ' Try oracleConn.Open() oracleCmd = New OracleCommand(sql, oracleConn) oracleadapter.SelectCommand = oracleCmd oracleadapter.Fill(NewDataset) End If If NewDataset.Tables(0).Rows.Count > 0 Then cmb.Items.Clear() 'Die Standargrösse definieren Dim newWidth As Integer = 300 For i = 0 To NewDataset.Tables(0).Rows.Count - 1 'MsgBox(NewDataset.Tables(0).Rows(i).Item(0)) AddComboBoxValue(cmb, NewDataset.Tables(0).Rows(i).Item(0)) Try Dim text As String = NewDataset.Tables(0).Rows(i).Item(0) If text.Length > 15 Then Dim g As Graphics = cmb.CreateGraphics If g.MeasureString(text, cmb.Font).Width + 30 > newWidth Then newWidth = g.MeasureString(text, cmb.Font).Width + 30 End If g.Dispose() End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Anpassung Breite ComboBox:") End Try Next cmb.Size = New Size(newWidth, 27) cmb.AutoCompleteSource = AutoCompleteSource.ListItems cmb.AutoCompleteMode = AutoCompleteMode.Suggest End If If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then Try adapter.Dispose() sqlCmd.Dispose() sqlCnn.Close() Catch ex As Exception End Try Else Try oracleadapter.Dispose() oracleCmd.Dispose() oracleConn.Close() Catch ex As Exception End Try End If End If End If Next End If Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Unexpected error in Renew_ComboboxResults - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Renew_ComboboxResults:") End Try End Sub Private Sub AddVorschlag_ComboBox(ID As Integer, indexname As String, y As Integer, conid As Integer, sql_Vorschlag As String, Optional Vorgabe As String = "") Try Dim connectionString As String Dim sqlCnn As SqlConnection Dim sqlCmd As SqlCommand Dim adapter As New SqlDataAdapter Dim oracleConn As OracleConnection Dim oracleCmd As OracleCommand Dim oracleadapter As New OracleDataAdapter Dim NewDataset As New DataSet Dim i As Integer Dim sql As String Dim runinLZ As Boolean = False connectionString = ClassDatabase.GetConnectionString(conid) If connectionString Is Nothing = False Then 'SQL Befehl füllt die Auswahlliste sql = sql_Vorschlag If Not sql.Contains("@") Then If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then sqlCnn = New SqlConnection(connectionString) sqlCnn.Open() sqlCmd = New SqlCommand(sql, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then oracleConn = New OracleConnection(connectionString) ' Try oracleConn.Open() oracleCmd = New OracleCommand(sql_Vorschlag, oracleConn) oracleadapter.SelectCommand = oracleCmd oracleadapter.Fill(NewDataset) End If Else runinLZ = True If LogErrorsOnly = False Then ClassLogger.Add(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False) End If Dim newCMB As ComboBox If runinLZ = True Then 'Die Standardcombobox anlegen newCMB = addCombobox(ID, indexname, y) newCMB.Size = New Size(300, 27) Else If NewDataset.Tables(0).Rows.Count > 0 Then 'Die Standardcombobox anlegen newCMB = addCombobox(ID, indexname, y) 'Die Standargrösse definieren Dim newWidth As Integer = 300 For i = 0 To NewDataset.Tables(0).Rows.Count - 1 'MsgBox(NewDataset.Tables(0).Rows(i).Item(0)) AddComboBoxValue(newCMB, NewDataset.Tables(0).Rows(i).Item(0)) Try Dim text As String = NewDataset.Tables(0).Rows(i).Item(0) If text.Length > 15 Then Dim g As Graphics = newCMB.CreateGraphics If g.MeasureString(text, newCMB.Font).Width + 30 > newWidth Then newWidth = g.MeasureString(text, newCMB.Font).Width + 30 End If g.Dispose() End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Anpassung Breite ComboBox:") End Try Next newCMB.Size = New Size(newWidth, 27) newCMB.AutoCompleteSource = AutoCompleteSource.ListItems newCMB.AutoCompleteMode = AutoCompleteMode.Suggest newCMB.DropDownHeight = (newCMB.ItemHeight + 0.2) * 25 If Vorgabe <> "" Then newCMB.SelectedIndex = newCMB.FindStringExact(Vorgabe) newCMB.Text = Vorgabe Get_NextComboBoxResults(newCMB) End If Else End If If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then Try adapter.Dispose() sqlCmd.Dispose() sqlCnn.Close() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) End Try Else Try oracleadapter.Dispose() oracleCmd.Dispose() oracleConn.Close() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) End Try End If End If End If Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in AddVorschlag_ComboBox:") End Try End Sub Sub Refresh_indices() Try If CURRENT_DOKARTID > 0 Then Dim sql = "SELECT OBJEKTTYP FROM TBDD_DOKUMENTART WHERE GUID = " & CURRENT_DOKARTID OBJECT_TYPETextBox.Text = ClassDatabase.Execute_Scalar(sql, True) DOCTYPE_IDTextBox.Text = CURRENT_DOKARTID sql = "SELECT * FROM TBDD_INDEX_AUTOM WHERE DOCTYPE_ID = " & CURRENT_DOKARTID Dim dt As DataTable = ClassDatabase.Return_Datatable(sql, True) Dim Count As Integer = 0 lvwIndices.Items.Clear() If dt.Rows.Count > 0 Then For Each row As DataRow In dt.Rows lvwIndices.Items.Add(row.Item("INDEXNAME").ToString) Dim Value As String Dim _case = row.Item("VALUE").ToString.ToUpper Select Case row.Item("VALUE").ToString.ToUpper Case "@DOKART" Value = CURRENT_DOKARTSTRING Case "@RECORD-ID" Value = CURRENT_RECORD_ID End Select lvwIndices.Items(Count).SubItems.Add(Value) Count += 1 Next End If 'den Entity-Key auslesen sql = "Select Top 1 * from TBPMO_WD_OBJECTTYPE where Upper(object_type) = Upper('" & OBJECT_TYPETextBox.Text & "')" dt = ClassDatabase.Return_Datatable(sql, True) If Not dt Is Nothing Then If dt.Rows.Count = 1 Then lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_ENTITYID").ToString) lvwIndices.Items(Count).SubItems.Add(CURRENT_ENTITY_ID) Count = Count + 1 lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_PARENTID").ToString) If CURRENT_REDUNDANT_FORM_ID <> 0 Then sql = "SELECT TOP 1 PARENT_ID FROM TBPMO_FORM WHERE GUID = " & CURRENT_REDUNDANT_FORM_ID Else sql = "SELECT TOP 1 PARENT_ID FROM TBPMO_FORM WHERE GUID = " & CURRENT_ENTITY_ID End If Dim ParentID = ClassDatabase.Execute_Scalar(sql, True) Try If IsNumeric(ParentID) And ParentID > 0 Then lvwIndices.Items(Count).SubItems.Add(ParentID) End If Catch ex As Exception MsgBox("Unexpected Error in Setting Parent-ID" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Count = Count + 1 ''den Record-Key auslesen 'lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_RECORDID").ToString) 'lvwIndices.Items(Count).SubItems.Add(CURRENT_RECORD_ID) 'Count = Count + 1 'lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_DOCTYPE").ToString) 'lvwIndices.Items(Count).SubItems.Add(CURRENT_DOKARTSTRING) End If End If End If Catch ex As Exception MsgBox("Error in Refresh Indices for Indexing:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub frmWD_Index_Dokart_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing My.Settings.Save() End Sub Private Sub frmWD_Index_Dokart_Load(sender As Object, e As EventArgs) Handles Me.Load Try CURRENT_FILENAME = "" Me.VWDDINDEX_AUTOMTableAdapter.Connection.ConnectionString = MyConnectionString chkMultiIndexer.Checked = False If LogErrorsOnly = False Then ClassLogger.Add(" >> frmWD_Index_Dokart_Load", False) chkdelete_origin.Checked = False chkdelete_origin.Visible = False Dim HandleType As String For Each row As DataRow In CURRENT_TBPMO_FILES_USER.Rows If row.Item("GUID") = CURRENT_FILEID Then CURRENT_FILENAME = row.Item("FILENAME2WORK") HandleType = row.Item("HANDLE_TYPE") End If Next If CURRENT_FILENAME = "" Then MsgBox("Chekc the Temp Files Table, as it seems to be empty!", MsgBoxStyle.Exclamation) Exit Sub End If MULTIFILES = 0 For Each row As DataRow In CURRENT_TBPMO_FILES_USER.Rows If row.Item("GUID") <> CURRENT_FILEID Then MULTIFILES += 1 End If Next If MULTIFILES > 0 Then chkMultiIndexer.Text = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren" chkMultiIndexer.Visible = True Else chkMultiIndexer.Visible = False End If aktFiledropped = CURRENT_FILENAME txtFilepath.Text = aktFiledropped If HandleType = "@DROPFROMFSYSTEM@" Then droptype = "dragdrop file" chkdelete_origin.Visible = True chkdelete_origin.Checked = WD_IndexDeleteDocs ElseIf HandleType = "@OUTLOOK_ATTMNT@" Then droptype = "dragdrop attachment" chkdelete_origin.Visible = True chkdelete_origin.Checked = WD_IndexDeleteDocs ElseIf HandleType = "@OUTLOOKMESSAGE@" Then droptype = "dragdrop message" chkdelete_origin.Visible = True chkdelete_origin.Checked = WD_IndexDeleteDocs ElseIf HandleType = "SCAM" Then droptype = "scan" End If VWPMO_DOKUMENTTYPESTableAdapter.Connection.ConnectionString = MyConnectionString Me.VWPMO_DOKUMENTTYPESTableAdapter.Fill(Me.DD_DMSDataSet.VWPMO_DOKUMENTTYPES, CURRENT_FORMVIEW_ID) CURRENT_REDUNDANT_FORM_ID = 0 CURRENT_REDUNDANT_FORMVIEW_ID = 0 If DD_DMSDataSet.VWPMO_DOKUMENTTYPES.Rows.Count = 0 Then If CURRENT_ENTITY_REDUNDANT_ID <> 0 Then Dim FVID = ClassDatabase.Execute_Scalar(String.Format("SELECT GUID FROM TBPMO_FORM_VIEW WHERE FORM_ID = {0} and SCREEN_ID = 1", CURRENT_ENTITY_REDUNDANT_ID), True) Me.VWPMO_DOKUMENTTYPESTableAdapter.Fill(Me.DD_DMSDataSet.VWPMO_DOKUMENTTYPES, FVID) If DD_DMSDataSet.VWPMO_DOKUMENTTYPES.Rows.Count = 0 Then MsgBox("No documenttypes for the redundant entity configured either! Indexing is not possible!" & vbNewLine & "Please check the configuration!", MsgBoxStyle.Exclamation) Exit Sub Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Redundant EntityID: " & CURRENT_ENTITY_REDUNDANT_ID) CURRENT_REDUNDANT_FORM_ID = CURRENT_ENTITY_REDUNDANT_ID CURRENT_REDUNDANT_FORMVIEW_ID = FVID CURRENT_ENTITY_ID = CURRENT_ENTITY_REDUNDANT_ID CURRENT_FORMVIEW_ID = FVID End If Else MsgBox("No documenttypes for this entity configured! Indexing is not possible!" & vbNewLine & "Please check the configuration!", MsgBoxStyle.Exclamation) Exit Sub End If End If Catch ex As Exception MsgBox("Error in frmWD_Index_Dokart_Load:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub chkdelete_origin_CheckedChanged(sender As Object, e As EventArgs) Handles chkdelete_origin.CheckedChanged WD_IndexDeleteDocs = chkdelete_origin.Checked SaveMySettingsValue("WD_IndexDeleteDocs", WD_IndexDeleteDocs, "ConfigMain") End Sub Private Sub frmWD_Index_Dokart_Shown(sender As Object, e As EventArgs) Handles Me.Shown Try If My.Settings.WD_INDEXDOKART_SAVE <> String.Empty Then Me.cmbDokumentart.SelectedItem = Me.cmbDokumentart.Items.IndexOf(My.Settings.WD_INDEXDOKART_SAVE) ' cmbDokumentart.SelectedIndex = cmbDokumentart.FindStringExact(My.Settings.WD_INDEXDOKART_SAVE) Else If DD_DMSDataSet.VWPMO_DOKUMENTTYPES.Rows.Count = 1 Then cmbDokumentart.SelectedIndex = 0 CURRENT_DOKARTID = cmbDokumentart.SelectedValue CURRENT_DOKARTSTRING = cmbDokumentart.Text Refresh_indices() End If End If Me.Hide() Me.Visible = True Me.Activate() Me.BringToFront() If CURRENT_CONTROL_DOCTYPE_MATCH <> "" Then 'Me.cmbDokumentart.SelectedItem = Me.cmbDokumentart.Items.IndexOf(CURRENT_CONTROL_DOCTYPE_MATCH) cmbDokumentart.SelectedIndex = cmbDokumentart.FindStringExact(CURRENT_CONTROL_DOCTYPE_MATCH) If cmbDokumentart.SelectedIndex = 0 And CURRENT_CONTROL_DOCTYPE_MATCH = cmbDokumentart.Text Then CURRENT_DOKARTID = cmbDokumentart.SelectedValue CURRENT_DOKARTSTRING = cmbDokumentart.Text Refresh_indices() End If End If Catch ex As Exception MsgBox("Error in Form Shown:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try formloaded = True End Sub Private Sub txtSubfolder_TextChanged(sender As Object, e As EventArgs) Handles txtSubfolder.TextChanged CURRENT_SUBFOLDER = txtSubfolder.Text End Sub End Class