shu
/
EDOKA_Batch
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 '07e8a2e4d1'
${ noResults }
EDOKA_Batch/edkb12/edkb12 V13/EDKB12WS/ModMain.vb

2201 lines
100 KiB
Raw Blame History Escape

Imports System.IO.File
Imports System.IO
Imports System.Data.SqlClient
Imports System.Data.SqlTypes
Imports System.ComponentModel
Imports System.SystemException
Imports System.Threading
Imports System.Reflection
Imports System.Data
Imports microsoft.Office.Interop.Word
Module ModMain
#Region "Deklarationen"
Dim args As String() = Environment.GetCommandLineArgs()
Dim RowId As Integer
Dim EDK_Data As New DataSet
Dim EDK_Daten As New System.Data.DataTable
Dim Filename As String
Dim FileExtension As String = ""
Dim DokumentFilename As String
Dim Dokumentid As String
Dim tmpAction As Action
Dim DokType As New edokadb.clsDokumenttyp
Dim Dok As New edokadb.clsDokument
Dim OfficeVorlage As New edokadb.clsOffice_vorlage
Dim OfficeVorlageDatei As New edokadb.clsOffice_Vorlage_Datei
Dim Partner As New edokadb.clsPartner
Dim xMitarbeiter As New edokadb.clsMyMitarbeiter
Dim Mitarbeiter As New edokadb.clsMitarbeiter
Dim Mitarbeiterdata As New System.Data.DataTable
Dim xdata As New System.Data.DataTable
Dim Dokumentdaten As New System.Data.DataTable
Dim Profile As New System.Data.DataTable
Dim Teams As New System.Data.DataTable
Dim WithEvents objword As Microsoft.Office.Interop.Word.Application
Dim WithEvents docword As Microsoft.Office.Interop.Word.Document
Dim Profilnr As Integer
Dim Unterschriftlinks As Integer
Dim Unterschriftrechts As Integer
Dim Teamnr As Integer
Dim IsProtected As Boolean = False
#End Region
Public Function Check_pendente_Dokumente() As Integer
'20080918 Version 12 SHU
'Im Fehlerfall mit -99 aus der Routine aussteigen
Try
EDK_Daten = Get_Pendente_EDK_Dokumente()
If EDK_Daten.Rows.Count < 1 Then
Return 0
End If
Dim rid As Integer = EDK_Daten.Rows(0).Item("RowId")
EDK_Daten.Dispose()
Return rid
Catch ex As Exception
Return -99
End Try
End Function
Public Sub Generate_Dokument(ByVal row As Integer)
Try
RowId = row
Set_EDK_Status(RowId, 1)
Filename = Param.WorkDir + "\" + Trim(Str(RowId)) & "_EDK_" & Format(Now, "dd_MM_yyyy hh_mm_ss") & "_" & ".edk"
DivFnkt.InsertJournale("EDKB12: Start " + Filename, clsDivFnkt.Enum_InfoTyp.Information)
' Applikationsdaten lasen
Dim Applikation As New edokadb.clsApplikation()
Applikation.cpMainConnectionProvider = Globals.conn
Applikation.iApplikationsnr = New SqlInt32(CType(1, Int32))
Globals.Applikationsdaten = Applikation.SelectOne
'Initialisierung vor Dokument_Bearbeitung / 20110208 SHU
EDK_Daten.Dispose()
EDK_Daten = Nothing
EDK_Daten = New System.Data.DataTable
EDK_Data.Dispose()
EDK_Data = Nothing
EDK_Data = New DataSet
xdata.Dispose()
xdata = Nothing
xdata = New System.Data.DataTable
Dokumentdaten.Dispose()
Dokumentdaten = Nothing
Dokumentdaten = New System.Data.DataTable
Profile.Dispose()
Profile = Nothing
Profile = New System.Data.DataTable
Teams.Dispose()
Teams = Nothing
Teams = New System.Data.DataTable
Mitarbeiterdata.Dispose()
Mitarbeiterdata = Nothing
Mitarbeiterdata = New System.Data.DataTable
DokType.Dispose()
OfficeVorlage.Dispose()
OfficeVorlageDatei.Dispose()
Partner.Dispose()
xMitarbeiter.Dispose()
Mitarbeiter.Dispose()
Mitarbeiterdata.Dispose()
objAvaloqDokumentWerte.clearAvaloqDokumentWerte()
If Not Get_EDK_Data() Then
Set_EDK_Status(RowId, 2)
Exit Sub
End If
If Not Check_EDK_Data() Then
Set_EDK_Status(RowId, 2)
Exit Sub
End If
If Not Check_Umfeld() Then
Set_EDK_Status(RowId, 2)
Exit Sub
End If
If Not Dokument_Erstellen() Then
Set_EDK_Status(RowId, 2)
Exit Sub
End If
If Not Dokumentdaten_Zusammenstellen() Then
Set_EDK_Status(RowId, 2)
Exit Sub
End If
If Not Generate_Word() Then
Set_EDK_Status(RowId, 2)
Exit Sub
End If
Try
EDK_Data.Tables.Clear()
EDK_Daten.Rows.Clear()
xdata.Rows.Clear()
Dokumentdaten.Rows.Clear()
Profile.Rows.Clear()
Teams.Rows.Clear()
Mitarbeiterdata.Rows.Clear()
EDK_Data.Dispose()
EDK_Daten.Dispose()
DokType.Dispose()
DokType.Dispose()
OfficeVorlage.Dispose()
OfficeVorlageDatei.Dispose()
Partner.Dispose()
xMitarbeiter.Dispose()
Mitarbeiter.Dispose()
Mitarbeiterdata.Dispose()
xdata.Dispose()
Dokumentdaten.Dispose()
Profile.Dispose()
Teams.Dispose()
tmpAction.Destroy()
objAvaloqDokumentWerte.clearAvaloqDokumentWerte()
File.Delete(Filename)
File.Delete(Filename + FileExtension)
Catch
End Try
Set_EDK_Status(RowId, 3)
DivFnkt.InsertJournale("EDKB12: Ende " + Filename, clsDivFnkt.Enum_InfoTyp.Information)
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12: Fehler:: " + ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End Try
End Sub
#Region "EDK - File"
Private Function Check_EDK_Data() As Boolean
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_EDK_Data", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
'File Checken
Dim file As New IO.FileInfo(Filename)
tmpAction = New Action
If Not tmpAction.Load(file) Then
Return False
End If
objAvaloqDokumentWerte.init(file)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Check_EDK_Data (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Check_EDK_Data::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Check_EDK_Data (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End Try
End Function
Private Function Get_EDK_Data()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Get_EDK_Data", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
Dim Connection As New SqlConnection()
Dim DA As New SqlDataAdapter("select * from edk_data where rowid = " & Str(RowId), Connection)
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
Connection.ConnectionString = Globals.Param.connectionstring
Connection.Open()
EDK_Data.Tables.Clear()
DA.Fill(EDK_Data, "EDK_Data")
Dim myRow As DataRow
myRow = EDK_Data.Tables(0).Rows(0)
Dim MyData() As Byte
MyData = myRow.Item(5)
Dim K As Long
K = UBound(MyData)
Dim fs As New FileStream(Filename, FileMode.OpenOrCreate, FileAccess.Write)
fs.Write(MyData, 0, K)
fs.Close()
fs = Nothing
DA = Nothing
cb = Nothing
Connection = Nothing
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Get_EDK_Data (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Get_EDK_Data::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Get_EDK_Data (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End Try
End Function
Private Function Get_Pendente_EDK_Dokumente() As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Get_Pendente_EDK_Dokumente", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "sp_edkb12"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.Parameters.Add(New SqlParameter("@rowid", SqlDbType.Int, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@status", SqlDbType.Int, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
sdaAdapter.Fill(dtToReturn)
Return dtToReturn
Catch ex As Exception
'20080918 Version 12 SHU
'Im Feherfall nichts auf DB schreiben. Passiert nachdem ein SQL-Verbindungsunterbruch stattgefunden hat.
Try
DivFnkt.InsertJournale("EDKB12::Fehler:: Get_Pendente_EDK_Dokumente::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Get_Pendente_EDK_Dokumente (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Catch
End Try
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Private Function Set_EDK_Status(ByVal rowid As Integer, ByVal status As Integer) As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Set_EDK_Status", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "sp_edkb12"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 2))
scmCmdToExecute.Parameters.Add(New SqlParameter("@rowid", SqlDbType.Int, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, rowid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@status", SqlDbType.Int, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, status))
sdaAdapter.Fill(dtToReturn)
Return dtToReturn
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Set_EDK_Status::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Set_EDK_Status (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
If status = 2 Then Send_Message(False, 2)
If status = 3 Then Send_Message(True, 3)
End Try
End Function
Private Sub Send_Message(ByVal ok As Boolean, ByVal status As Integer)
Dim betreff As String
Dim meldung As String
If ok Then
betreff = Param.OKMeldungBetreff
meldung = Param.OKMeldung
Else
betreff = Param.NOKMeldungBetreff
meldung = Param.NOKMeldung
End If
betreff = betreff.Replace("#Partnernr#", Trim(Str(Partner.iNRPAR00.Value)))
meldung = meldung.Replace("#Dokumenttyp#", Trim(DokType.sBezeichnung.Value))
meldung = meldung.Replace("#Partnernr#", Trim(Str(Partner.iNRPAR00.Value)))
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "sp_edkb12_meldung"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@status", SqlDbType.Int, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, status))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiter", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Mitarbeiter.iMitarbeiternr.Value))
scmCmdToExecute.Parameters.Add(New SqlParameter("@betreff", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, betreff))
scmCmdToExecute.Parameters.Add(New SqlParameter("@meldung", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, meldung))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Dokumentid))
sdaAdapter.Fill(dtToReturn)
Return
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Send_Message::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Send_Message (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Sub
#End Region
#Region "Check Umfeld - Berechtigung, BP, Doktyp usw."
Private Function Check_Umfeld() As Boolean
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld::Mitarbeiter", clsDivFnkt.Enum_InfoTyp.Information)
End If
xMitarbeiter.xtgnummer = tmpAction.GetParameterByName("creatorTg").Value
Mitarbeiter.cpMainConnectionProvider = Globals.conn
conn.OpenConnection()
xMitarbeiter.cpMainConnectionProvider = Globals.conn
Mitarbeiterdata = xMitarbeiter.SelectWithTGNummer()
conn.CloseConnection(True)
Mitarbeiter.cpMainConnectionProvider = Globals.conn
conn.OpenConnection()
Mitarbeiter.iMitarbeiternr = New SqlInt32(Mitarbeiterdata.Rows(0).Item("Mitarbeiternr"))
Mitarbeiter.SelectOne()
conn.CloseConnection(True)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld::Dokumenttyp", clsDivFnkt.Enum_InfoTyp.Information)
End If
DokType.cpMainConnectionProvider = Globals.conn
conn.OpenConnection()
DokType.iDokumenttypnr = New SqlInt32(tmpAction.GetParameterByName("DokumentTypNr").Value - 900000000)
DokType.SelectOne()
conn.CloseConnection(True)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld::Partner", clsDivFnkt.Enum_InfoTyp.Information)
End If
Partner.cpMainConnectionProvider = Globals.conn
conn.OpenConnection()
Partner.iNRPAR00 = New SqlInt32(tmpAction.GetParameterByName("PartnerNr").Value)
Partner.SelectOne()
conn.CloseConnection(True)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld::Office-Vorlage", clsDivFnkt.Enum_InfoTyp.Information)
End If
OfficeVorlage.cpMainConnectionProvider = Globals.conn
conn.OpenConnection()
OfficeVorlage.iOffice_vorlagenr = New SqlInt32(DokType.iOffice_vorlagenr.Value)
OfficeVorlage.SelectOne()
conn.CloseConnection(True)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld::Auslesen Office-Vorlage", clsDivFnkt.Enum_InfoTyp.Information)
End If
'Office 2010
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld::Param.CheckOffice2010_Vorlage:" + Param.CheckOffice2010_Vorlage.ToString, clsDivFnkt.Enum_InfoTyp.Information)
End If
If Param.CheckOffice2010_Vorlage = True Then
Dim applnr As Integer = Get_Applikationnr(OfficeVorlage.iOffice_vorlagenr.Value)
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld::Appl-Nr:" + applnr.ToString, clsDivFnkt.Enum_InfoTyp.Information)
Select Case applnr
Case 0
FileExtension = ".doc"
Case 1
FileExtension = ".doc"
Case 2
FileExtension = ".xls"
Case 3
FileExtension = ".pdf"
Case 4
FileExtension = ".docx"
Case 5
FileExtension = ".docm"
Case 6
FileExtension = ".dotx"
Case 7
FileExtension = ".dotm"
Case 8
FileExtension = ".xlsx"
Case 9
FileExtension = ".xlsm"
Case 10
FileExtension = ".xltx"
Case 11
FileExtension = ".xltm"
End Select
Else
Select Case OfficeVorlage.iAnwendungnr.Value
Case 0
FileExtension = ".doc"
Case 1
FileExtension = ".doc"
Case 2
FileExtension = ".xls"
Case 3
FileExtension = ".pdf"
Case 4
FileExtension = ".docx"
Case 5
FileExtension = ".docm"
Case 6
FileExtension = ".dotx"
Case 7
FileExtension = ".dotm"
Case 8
FileExtension = ".xlsx"
Case 9
FileExtension = ".xlsm"
Case 10
FileExtension = ".xltx"
Case 11
FileExtension = ".xltm"
End Select
End If
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld:: Office_Voralge: " + OfficeVorlage.iOffice_vorlagenr.Value.ToString, clsDivFnkt.Enum_InfoTyp.Information)
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld:: Dokumenttyp: " + FileExtension, clsDivFnkt.Enum_InfoTyp.Information)
End If
If Office_Vorlage_Get_From_DB(OfficeVorlage.iOffice_vorlagenr.Value, Filename + FileExtension) = "" Then
Return False
End If
DokumentFilename = Filename + FileExtension
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld::Profil", clsDivFnkt.Enum_InfoTyp.Information)
End If
Profile = Get_Profil(Mitarbeiter.iMitarbeiternr.Value)
If Profile.Rows.Count < 1 Then
Profilnr = 0
Unterschriftlinks = 0
Unterschriftrechts = 0
Else
Profilnr = Profile.Rows(0).Item("Profilnr")
Unterschriftlinks = Profile.Rows(0).Item("Unterschriftlinks")
Unterschriftrechts = Profile.Rows(0).Item("Unterschriftrechts")
End If
Profile.Dispose()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Check_Umfeld::Teams", clsDivFnkt.Enum_InfoTyp.Information)
End If
Teams = Get_Team(Profilnr)
If Teams.Rows.Count = 0 Then
teamnr = 0
Else
teamnr = Teams.Rows(0).Item("Teamnr")
End If
Teams.Dispose()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Check_Umfeld (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Check_Umfeld::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Check_Umfeld (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End Try
End Function
Public Function Office_Vorlage_Get_From_DB(ByVal office_vorlagenr As Integer, ByVal Filename As String) As String
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Office_Vorlage_Get_From_DB", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim s As String = "Select * From office_vorlage_datei where office_vorlage_Dateinr=" + Trim(Str(office_vorlagenr))
If Param.CheckOffice2010_Vorlage = True Then
s = "Select * from Office2010_Vorlage_datei where office_vorlage_dateinr=" + Trim(Str(office_vorlagenr))
End If
Dim connection As New SqlConnection()
Dim da As New SqlDataAdapter(s, connection)
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da)
Dim ds As New DataSet()
Try
connection.ConnectionString = Param.connectionstring
connection.Open()
da.Fill(ds, "docs")
Dim myRow As DataRow
myRow = ds.Tables(0).Rows(0)
Dim MyData() As Byte
MyData = myRow.Item(2)
Dim K As Long
K = UBound(MyData)
Dim fs As New FileStream(Filename, FileMode.OpenOrCreate, FileAccess.Write)
fs.Write(MyData, 0, K)
fs.Close()
fs = Nothing
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende GOffice_Vorlage_Get_From_DB (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return Filename
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Office_Vorlage_Get_From_DB::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende GOffice_Vorlage_Get_From_DB (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return ""
End Try
CB = Nothing
ds = Nothing
da = Nothing
connection.Close()
connection = Nothing
End Function
Public Function Get_Applikationnr(ByVal Dateinr As Integer) As Integer
Try
Dim connection As New SqlConnection()
Dim da As New SqlDataAdapter("Select * From Office2010_Vorlage_datei where Office_Vorlage_Dateinr=" + Dateinr.ToString, connection)
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da)
Dim ds As New DataSet()
Try
connection.ConnectionString = Param.connectionstring
connection.Open()
da.Fill(ds, "docs")
If ds.Tables(0).Rows.Count > 0 Then
Return ds.Tables(0).Rows(0).Item(3)
Else
Return 0
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
CB = Nothing
ds = Nothing
da = Nothing
connection.Close()
connection = Nothing
CB = Nothing
ds = Nothing
da = Nothing
connection.Close()
connection = Nothing
Catch ex As Exception
Return 0
End Try
End Function
#End Region
#Region "Dokument erstellen"
Private Function Dokument_Erstellen()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Dokument_Erstellen", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
Dok.cpMainConnectionProvider = Globals.conn
Dokumentid = Globals.DivFnkt.Generate_Key
Dok.sDokumentid = New SqlString(CType(Dokumentid, String))
'***************************************************************************************************************3
'Defaultwerte f<>r das Dokument
'***************************************************************************************************************3
Dok.bAktiv = New SqlBoolean(True)
Dok.bAmsdokument = New SqlBoolean(CType(False, Boolean))
Dok.bAuserstuebernahme = New SqlBoolean(CType(False, Boolean))
Dok.bAusgangsarchiviert = New SqlBoolean(CType(False, Boolean))
Dok.iStatus_edoka_batch_ausgang = Nothing
Dok.daTermin = New SqlDateTime(CType("01.01.1900", DateTime))
Dok.bBereit_zur_archivierung = New SqlBoolean(CType(True, Boolean))
Dok.bEingangsarchiviert = New SqlBoolean(CType(False, Boolean))
Dok.bGesperrt = New SqlBoolean(CType(False, Boolean))
Dok.bUnvollstaendig = New SqlBoolean(CType(False, Boolean))
Dok.iBck = New SqlInt32(CType(1, Int32))
Dok.iColdstatus = New SqlInt32(CType(0, Int32))
Dok.iUnterschriftlinks = New SqlInt32(CType(Unterschriftlinks, Int32))
Dok.iUnterschriftrechts = New SqlInt32(CType(Unterschriftrechts, Int32))
Dok.iVerantwortlich = New SqlInt32(CType(Mitarbeiter.iMitarbeiternr.Value, Int32))
Dok.bVertraulich = New SqlBoolean(CType(False, Boolean))
Dok.sZustelladresse = New SqlString(CType("", String))
Dok.sAnredezustelladresse = New SqlString(CType("", String))
Dok.iZustaendiger = New SqlInt32(CType(Mitarbeiter.iMitarbeiternr.Value, Int32))
Dok.iPostzustellung = New SqlInt32(CType(0, Int32))
Dok.bZustaendig_kube = New SqlBoolean(CType(0, Boolean))
Dok.iMa_ausgangsarchivierung = New SqlInt32(CType(0, Int32))
Dok.iMa_eingangsarchivierung = New SqlInt32(CType(0, Int32))
Dok.sBemerkung = New SqlString(CType("", String))
Dok.sColddokumentid = New SqlString(CType("", String))
Dok.iDokdurchkubeweitergegeben = New SqlInt32(CType(0, Int32))
Dok.sBedRDokumentid = New SqlString(CType("", String))
Dok.bBldossier = New SqlBoolean(CType(False, Boolean))
'***************************************************************************************************************3
'Werte aus Dokumenttyp
'***************************************************************************************************************3
Dok.iDokumenttypnr = New SqlInt32(CType(DokType.iDokumenttypnr.Value, Int32))
Dok.bZu_retournieren = New SqlBoolean(CType(DokType.bZu_retournieren.Value, Boolean))
Dok.iAufbewahrung_elektronisch = New SqlInt32(CType(DokType.iAufbewahrungsfrist_elektronisch.Value, Int32))
Dok.iAufbewahrung_phaysisch = New SqlInt32(CType(DokType.iAufbewahrungsfrist_physisch.Value, Int32))
Dok.iBearbeitung_nach_abschluss = New SqlInt32(CType(DokType.iTage_mutation.Value, Int32))
Dok.iBearbeitungszeit_in_minuten = New SqlInt32(CType(DokType.iDbearbeitungszeit.Value, Int32))
Dok.iMonierung_in_tagen = New SqlInt32(CType(DokType.iAnzahl_tage.Value, Int32))
Dok.sBezeichnung = New SqlString(CType(DokType.sBezeichnung.Value, String))
'***************************************************************************************************************3
'Werte aus der Schnittstelle bzw. Defaultwerte
'***************************************************************************************************************3
Dok.iNrpar00 = New SqlInt32(CType(Partner.iNRPAR00.Value, Int32))
Dok.daArchivierungsdatum = New SqlDateTime(CType(Now, DateTime))
'Ersteller und Mutierer
Dok.iErsteller = New SqlInt32(CType(Mitarbeiter.iMitarbeiternr.Value, Int32))
Dok.iMutierer = Dok.iErsteller
Dok.iMitarbeiternr = Dok.iErsteller
'Erstellungs- und Mutationsdatum
Dok.daMutiertam = New SqlDateTime(CType(Now, DateTime))
Dok.daErstelltam = New SqlDateTime(CType(Now, DateTime))
Dok.iMutierertieam = New SqlInt32(CType(Teamnr, Int32))
Dok.iErstellerteam = New SqlInt32(CType(Teamnr, Int32))
Dok.daErstellungsdatum = New SqlDateTime(CType(Dok.daArchivierungsdatum.Value, DateTime))
Dok.sDokumentname = New SqlString(CType(OfficeVorlage.sPrefix_dokumentname.Value + Dokumentid + FileExtension, String))
Dok.iAnzeigeStatus = New SqlInt32(CType(0, Int32))
conn.OpenConnection()
Dok.Insert()
conn.CloseConnection(True)
Dim t As System.Data.DataTable
Try
t = Cold_Werte(Dok.iDokumenttypnr.Value)
Dok.sColdfolder = New SqlString(CType(t.Rows(0).Item(0), String))
Dok.sColdschema = New SqlString(CType(t.Rows(0).Item(1), String))
Globals.conn.OpenConnection()
Dok.Update()
Globals.conn.CloseConnection(True)
Catch
End Try
'FANummerin im EDOKA-Dokumentaktualisieren
Update_FANummer(tmpAction.GetParameterByName("fanummer3").Value)
Dok.SelectOne()
'Cold_index erstellen
COLD_Index_Sichern(1, Dokumentid)
If Dok.bZu_retournieren.Value = True Then
COLD_Index_Sichern(2, Dokumentid)
End If
'VVNummer im COLDIndex aktualisieren, sofern als Indexwert <20>bergeben
Dok.iStatusnr = New SqlInt32(CType(Dokumentstatus_erstellen_und_Status_Setzen(Dokumentid, True, 0), Int32))
'Dokumentstatus erstelln und Statushistory_eintragen
'dok.iStatusnr = New SqlInt32(CType(Dokumentstatus_erstellen_und_Status_Setzen(datarow, True), Int32))
'Dokument auf der Datenbank speichern
'Abh<62>ngig vom entsprechenden Status, wird das Flag, bereit zur Ausgangsarchivierung wieder entfernt
Globals.conn.OpenConnection()
Dok.Update()
Globals.conn.CloseConnection(True)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokument_Erstellen (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Dokument_Erstellen::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokument_Erstellen (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End Try
End Function
Private Function Get_Team(ByVal profilnr As Integer) As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Get_Team", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_dokumentbearbeitung_team"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@profilnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, profilnr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
sdaAdapter.Fill(dtToReturn)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Get_Team (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return dtToReturn
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Get_Team::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Get_Team (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
Globals.conn.CloseConnection(True)
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Private Function Get_Profil(ByVal Mitarbeiternr As Integer) As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Get_ProfilGet_Team", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_edkb12_profil"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Mitarbeiternr))
sdaAdapter.Fill(dtToReturn)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Get_Profil (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return dtToReturn
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Get_Profil::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Get_Profil (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
Globals.conn.CloseConnection(True)
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Private Function Dokumentdaten_Zusammenstellen() As Boolean
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Dokumentdaten_Zusammenstellen", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
xdata = DokumentwertListe_laden(Dokumentid)
Dokumentwerte_Sichern()
xdata = Nothing
xdata = Dokumentwerte(Dokumentid)
Dokumentdaten = Dokumentwerte(Dokumentid)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokumentdaten_Zusammenstellen (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Dokumentdaten_Zusammenstellen::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokumentdaten_Zusammenstellen (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End Try
End Function
#End Region
#Region "ColdIndex und Dokumentwerte"
Private Function Update_FANummer(ByVal fanummer3 As String) As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Get_EDK_Data", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "sp_edoka_import_update_fanummer"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fanummer2", SqlDbType.VarChar, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
If fanummer3 <> "" Then
scmCmdToExecute.Parameters.Add(New SqlParameter("@fanummer1", SqlDbType.VarChar, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, "Ordernr: " & fanummer3))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fanummer3", SqlDbType.VarChar, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, "Avalog: " & fanummer3))
Else
scmCmdToExecute.Parameters.Add(New SqlParameter("@fanummer1", SqlDbType.VarChar, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fanummer3", SqlDbType.VarChar, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
End If
sdaAdapter.Fill(dtToReturn)
Return dtToReturn
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Get_EDK_Data::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Get_EDK_Data (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Private Function Cold_Werte(ByVal dokumenttypnr As Integer) As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Cold_Werte", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "sp_archiv_getschema_doc"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttypnr", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumenttypnr))
sdaAdapter.Fill(dtToReturn)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Cold_Werte(True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return dtToReturn
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Cold_Werte::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Cold_Werte (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Function COLD_Index_Sichern(ByVal indextyp As Integer, ByVal dokumentid As String) As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start COLD_Index_Sichern", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Dokument_Cold_Index"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@indextyp", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, indextyp))
sdaAdapter.Fill(dtToReturn)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende COLD_Index_Sichern (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return dtToReturn
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: COLD_Index_Sichern::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende COLD_Index_Sichern (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Function Update_DokumentColdIndexwert(ByVal dokumentid As String, ByVal Indextyp As Integer, ByVal indexfeld As Integer, ByVal wert As String) As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Update_DokumentColdIndexwert", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Archiv_Update_DokumentColdIndexwert"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Globals.conn.OpenConnection()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@indextyp", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Indextyp))
scmCmdToExecute.Parameters.Add(New SqlParameter("@indexfeld", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, indexfeld))
scmCmdToExecute.Parameters.Add(New SqlParameter("@wert", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, wert))
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
Try
sdaAdapter.Fill(dtToReturn)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Update_DokumentColdIndexwert (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return dtToReturn
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Update_DokumentColdIndexwert::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Update_DokumentColdIndexwert (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
Globals.conn.CloseConnection(True)
End Try
End Function
Private Function DokumentwertListe_laden(ByVal dokumentid As String) As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start DokumentwertListe_laden", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim i As Integer
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.SP_Dokumentbearbeitung_Dokumentwerte"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttypnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, DokType.iDokumenttypnr.Value))
scmCmdToExecute.Parameters.Add(New SqlParameter("@CreateNew", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
sdaAdapter.Fill(dtToReturn)
For i = 0 To dtToReturn.Rows.Count - 1
Dim objDokumentWert As AvaloqDokumentWert
If Not dtToReturn.Rows(i).Item(0) Is System.DBNull.Value Then
objDokumentWert = objAvaloqDokumentWerte.getAvaloqDokumentWertByName(dtToReturn.Rows(i).Item(0))
End If
If objDokumentWert Is Nothing = False Then
dtToReturn.Rows(i).Item(2) = objDokumentWert.value
End If
objDokumentWert = Nothing
Next
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende DokumentwertListe_laden (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return dtToReturn
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: DokumentwertListe_laden::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende DokumentwertListe_laden (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Sub Dokumentwert_Sichern(ByVal wert As String, ByVal feldnr As Integer)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Dokumentwert_Sichern", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Dokument_Information_Wert"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
scmCmdToExecute.Connection.Open()
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@vorlagenfeldnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, feldnr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, wert))
scmCmdToExecute.ExecuteNonQuery()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokumentwert_Sichern (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Dokumentwert_Sichern::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokumentwert_Sichern (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
End Try
End Sub
Public Sub Dokumentwerte_Sichern()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Dokumentwerte_Sichern", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim i As Integer
For i = 0 To xdata.Rows.Count - 1
If xdata.Rows(i).Item("cold_indexfeld") Is System.DBNull.Value Then xdata.Rows(i).Item("cold_indexfeld") = 0
If xdata.Rows(i).Item("cold_indexfeld") = 0 Then
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Dokument_Information_Wert"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@vorlagenfeldnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, xdata.Rows(i).Item("vorlagenfeldnr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 8000, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, xdata.Rows(i).Item("feldwert")))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Dokumentwerte_Sichern::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokumentwerte_Sichern (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
End Try
End If
Next
xdata.Dispose()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokumentwerte_Sichern (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
End Sub
Private Function Dokumentwerte(ByVal dokumentid As String) As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Dokumentwerte", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Dokumentwerte"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@ierrorcode", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
Try
sdaAdapter.Fill(dtToReturn)
Return dtToReturn
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokumentwerte (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Dokumentwerte::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokumentwerte (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
#End Region
#Region "Status"
Private Function Dokumentstatus_erstellen_und_Status_Setzen(ByVal dokumentid As String, ByVal erstellen As Boolean, Optional ByVal BLKunde As Integer = 0) As Integer
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Dokumentstatus_erstellen_und_Status_Setzen", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
Dim st As New System.Data.DataTable()
Dim i As Integer
Dim dt As DateTime = DateAdd(DateInterval.Second, -5, Now)
Dim MitArchivfunktion As Boolean = False
If erstellen = True Then
Create_Dokumentstatus(BLKunde)
End If
st = Get_Dokumentstatus()
For i = 0 To st.Rows.Count - 1
Select Case Integer.Parse(st.Rows(i).Item(2).ToString)
Case 3
MitArchivfunktion = True
Case 11
MitArchivfunktion = True
End Select
Next
If MitArchivfunktion Then
For i = 0 To st.Rows.Count - 1
insert_history_status(st.Rows(i).Item(0), dokumentid, Mitarbeiter.iMitarbeiternr.Value, dt)
dt = DateAdd(DateInterval.Second, 1, dt)
If st.Rows(i).Item(2) = 3 Or st.Rows(i).Item(2) = 11 Then
Return st.Rows(i).Item(0)
Exit Function
End If
Next
Else
'Dokumentstatusreihenfolge ohne Ausgangsarchivierung
End If
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokumentstatus_erstellen_und_Status_Setzen (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Catch ex As Exception
End Try
DivFnkt.InsertJournale("EDKB12::Fehler:: Dokumentstatus_erstellen_und_Status_Setzen::", clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokumentstatus_erstellen_und_Status_Setzen (False)", clsDivFnkt.Enum_InfoTyp.Information)
End If
End Function
Private Function Create_Dokumentstatus(Optional ByVal blkunde As Integer = 0) As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Create_Dokumentstatus", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_dokumentberabeigung_status_erstellen"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@bck", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
If blkunde = 0 Then
scmCmdToExecute.Parameters.Add(New SqlParameter("@blsequenz", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
Else
scmCmdToExecute.Parameters.Add(New SqlParameter("@blsequenz", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
End If
sdaAdapter.Fill(dtToReturn)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Create_Dokumentstatus (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return dtToReturn
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Create_Dokumentstatus::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Create_Dokumentstatus (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
Globals.conn.CloseConnection(True)
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Private Function Get_Dokumentstatus() As System.Data.DataTable
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Get_Dokumentstatus", clsDivFnkt.Enum_InfoTyp.Information)
End If
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As System.Data.DataTable = New System.Data.DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_edoka_import_get_dokumentstatus"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = Globals.conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Dokumentid))
sdaAdapter.Fill(dtToReturn)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Get_Dokumentstatus (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return dtToReturn
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Get_Dokumentstatus::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Get_Dokumentstatus (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Finally
Globals.conn.CloseConnection(True)
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Sub insert_history_status(ByVal statusnr As Integer, ByVal dokumentid As String, ByVal Verantwortlicher As Integer, ByVal datumzeit As DateTime)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start insert_history_status", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
Dim sh As New edokadb.clsStatushistory()
Dim dbkey As New edokadb.clsMyKey_Tabelle()
Dim key As Long
dbkey.cpMainConnectionProvider = Globals.conn
key = dbkey.get_dbkey("statushistory")
sh.cpMainConnectionProvider = Globals.conn
sh.iStatushistorynr = New SqlInt32(CType(key, Int32))
sh.iStatus = New SqlInt32(CType(statusnr, Int32))
sh.iMandantnr = New SqlInt32(CType(1, Int32))
sh.iMutierer = New SqlInt32(CType(Mitarbeiter.iMitarbeiternr.Value, Int32))
sh.bAktiv = New SqlBoolean(True)
sh.daErstellt_am = New SqlDateTime(CType(datumzeit, DateTime))
sh.daMutiert_am = New SqlDateTime(CType(datumzeit, DateTime))
sh.sDokumentid = New SqlString(CType(dokumentid, String))
sh.iVerantwortlich = New SqlInt32(CType(Verantwortlicher, Int32))
Try
Globals.conn.OpenConnection()
Catch
End Try
sh.Insert()
Try
Globals.conn.CloseConnection(True)
Catch
End Try
dbkey.Dispose()
sh.Dispose()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende insert_history_status (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: insert_history_status::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende insert_history_status (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
End Try
End Sub
#End Region
#Region "Word erstellen"
Private Function Generate_Word() As Boolean
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Generate_Word", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
If Not StartWord() Then
Return True
Exit Function
End If
objword.Documents.Open(DokumentFilename)
docword = objword.ActiveDocument
objword.NormalTemplate.Saved = True
objword.Visible = True
If Not Word_Werte_Auslesen(xdata) Then
DivFnkt.InsertJournale("EDKB12::Fehler:: Generate_Word: Word_Werte_auslesen", clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12::Fehler:: Generate_Word: Word_Werte_auslesen", clsDivFnkt.Enum_InfoTyp.Information)
End If
End If
If Not Dokument_Vervollstaendigen(xdata) Then
DivFnkt.InsertJournale("EDKB12::Fehler:: Generate_Word: Dokument_Vervollstaendigen", clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12::Fehler:: Generate_Word: Dokument_Vervollstaendigen", clsDivFnkt.Enum_InfoTyp.Information)
End If
End If
docword = objword.ActiveDocument
docword.Save()
docword.Close()
docword = Nothing
objword.Quit(False)
objword = Nothing
If Save_Doc() = True Then
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Generate_Word (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Else
DivFnkt.InsertJournale("EDKB12::Fehler:: Generate_Word: Save_Doc", clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12::Fehler:: Generate_Word: Save_Doc", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End If
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Generate_Word::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Generate_Word (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End Try
End Function
Private Function StartWord() As Boolean
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start StartWord", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
objword = CreateObject("Word.application")
objword.Application.Options.SaveInterval = 0
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende StartWord (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: StartWord::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende StartWord (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
Finally
objword.Visible = False
End Try
Try
'objword.Run("Autoexec")
Catch
End Try
Return True
End Function
Public Function Word_Werte_Auslesen(ByVal xdata As System.Data.DataTable) As Boolean
Try
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
Return True
Catch ex As Exception
Return False
End Try
End Function
Public Function Dokument_Vervollstaendigen(ByVal xdata As System.Data.DataTable) As Boolean
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Dokument_Vervollstaendigen", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
If docword.ProtectionType <> WdProtectionType.wdNoProtection Then
docword.Unprotect(Password:=Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_wordvorlagen"))
IsProtected = True
End If
Fill_Dokument()
If DokType.bZu_retournieren.Value = True Or DokType.iDoktypbedingteretournierung.Value > 0 Then
Generate_Barcodes()
Else
Try
objword.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekMainDocument
Catch
End Try
End If
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
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
IDV_makros_bearbeiten()
'Rel 3.5 / BUD / 13.01.2005 (IF / END IF)
'Dim dn As String = objword.ActiveDocument.FullName
'docword.Save()
'docword.Close()
'objword.Documents.Open(dn)
'objword.NormalTemplate.Saved = True
'docword = objword.ActiveDocument
'docword.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
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokument_Vervollstaendigen (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Dokument_Vervollstaendigen::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Dokument_Vervollstaendigen (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End Try
End Function
Private Function Fill_Dokument() As Boolean
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Fill_Dokument", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
If OfficeVorlage.bKopfzeile_generieren.Value = True Then
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Vor Insert Kopfzeile", clsDivFnkt.Enum_InfoTyp.Information)
End If
Insert_Kopfzeile()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Nach Insert Kopfzeile", clsDivFnkt.Enum_InfoTyp.Information)
End If
End If
Dokumentwerte_Uebertragen()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Fill_Dokument (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Fill_Dokument::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Fill_Dokument (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End Try
End Function
Private Sub Insert_Kopfzeile()
On Error Resume Next
objword.Selection.HomeKey(Unit:=WdUnits.wdStory)
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
set_headerbookmark()
objWord.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekMainDocument
End Sub
Private Sub set_headerbookmark()
Try
docword.Bookmarks.Item("TGEDKCompanyBBEB99").Select()
Catch
objword.Selection.MoveDown(Unit:=WdUnits.wdLine, Count:=1)
With objword.ActiveDocument.Bookmarks
.Add(Range:=objword.Selection.Range, Name:="TGEDKCompanyBBEB99")
.DefaultSorting = WdBookmarkSortBy.wdSortByName
.ShowHidden = False
End With
End Try
End Sub
Private Function Dokumentwerte_Uebertragen() As Boolean
Dim i As Long
Dim pos As Long
Dim pos2 As Long
Dim Fieldlen As Long
Dim temp1 As String
Dim temp2 As String
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Dokumentwerte_Uebertragen", clsDivFnkt.Enum_InfoTyp.Information)
End If
For i = 0 To Dokumentdaten.Rows.Count - 1
If Param.DebugMode Then
Try
temp1 = Dokumentdaten.Rows(i).Item("beginntextmarke")
Catch ex As Exception
temp1 = ""
End Try
Try
temp2 = Dokumentdaten.Rows(i).Item("feldname")
Catch ex As Exception
temp2 = ""
End Try
DivFnkt.InsertJournale("EDKB12: Dokumentwerte_Uebertragen:" & temp1 & ":" & temp2, clsDivFnkt.Enum_InfoTyp.Information)
End If
'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
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 Dokumentdaten.Rows(i).Item("used") = 1 Then
objword.Selection.Text = Dokumentdaten.Rows(i).Item("xvalue")
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:=WdUnits.wdCharacter, Count:=1)
'hutter
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:=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:=WdUnits.wdCharacter, Count:=1)
objword.Selection.MoveLeft(Unit:=WdUnits.wdCharacter, Count:=2, Extend:=WdMovementType.wdExtend)
If objword.Selection.Text = " " Then
objword.Selection.MoveRight(Unit:=WdUnits.wdCharacter, Count:=1)
objword.Selection.MoveLeft(Unit:=WdUnits.wdCharacter, Count:=1, Extend:=WdMovementType.wdExtend)
objword.Selection.Delete(Unit:=WdUnits.wdCharacter, Count:=1)
End If
Catch
End Try
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 Dokumentdaten.Rows(i).Item("used") = 1 Then
objword.Selection.TypeText(Text:=Dokumentdaten.Rows(i).Item("xvalue"))
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 Dokumentdaten.Rows(i).Item("used") = 1 Then
docword.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).Result = convert_wordfelder(Dokumentdaten.Rows(i).Item("xvalue"))
End If
Catch
End Try
End If
End If
End If
Next
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Ende Dokumentwerte_Uebertragen", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
End Function
Private Sub FeldMakros()
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
End Sub
Function convert(ByVal x As String) As String
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
End Function
Function convert_wordfelder(ByVal x As String) As String
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
End Function
Public Function Save_Doc() As Boolean
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Save_Doc", clsDivFnkt.Enum_InfoTyp.Information)
End If
If Save_To_DB(Dokumentid, DokumentFilename) = True Then
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Save_Doc (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Else
DivFnkt.InsertJournale("EDKB12::Fehler:: Save_Doc::", clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Save_Doc (False)::", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End If
End Function
Public Function Save_To_DB(ByVal sDokumentID As String, ByVal sDokumentName As String) As Boolean
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start Save_To_DB", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
Dim Connection As New SqlConnection()
Dim DA As New SqlDataAdapter("select * from doks where dokumentid='" + Dokumentid + "'", Connection)
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
Dim ds As New DataSet()
Dim fs As New FileStream(DokumentFilename, FileMode.Open, FileAccess.Read)
Dim mydata(fs.Length) As Byte
Try
fs.Read(mydata, 0, fs.Length)
fs.Close()
Connection.ConnectionString = Param.connectionstring
Connection.Open()
DA.Fill(ds, "docs")
Dim myRow As DataRow
If ds.Tables(0).Rows.Count = 0 Then
' Neues Dokument speichern
myRow = ds.Tables(0).NewRow
myRow.Item(0) = Dokumentid
myRow.Item(1) = mydata
ds.Tables(0).Rows.Add(myRow)
DA.Update(ds, "docs")
Else
'Bestehendes Dokument sichenr
myRow = ds.Tables(0).Rows(0)
myRow.Item(1) = mydata
DA.Update(ds, "docs")
End If
Catch ex As Exception
Return False
End Try
fs = Nothing
cb = Nothing
ds = Nothing
DA = Nothing
Connection.Close()
Connection = Nothing
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Save_To_DB (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Catch EX As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: Save_To_DB::" & EX.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende Save_To_DB (False)::" & EX.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End Try
End Function
#End Region
#Region "Barcode"
Dim Textboxes(100) As String
Dim Textboxesi As Integer
Private Sub Generate_Barcodes()
delete_Textfelder()
Insert_TextFelder()
ins_Barcode()
End Sub
Private Sub delete_Textfelder()
Dim xname As String
Dim i As Integer
Dim i1 As Integer
Dim pages As Long
Dim Prop As Object
objword.Selection.HomeKey(Unit:=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:=WdGoToItem.wdGoToPage, Name:=xname)
HeaderFooterAnzeigen()
While objWord.Selection.HeaderFooter.Shapes.Count > 0
objWord.Selection.HeaderFooter.Shapes.Item(1).Delete()
End While
objword.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekMainDocument
Next i
Exit Sub
eh:
Resume Next
End Sub
Private Sub Insert_TextFelder()
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:=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:=WdGoToItem.wdGoToPage, Name:=xname)
insert_Textfield()
objWord.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekMainDocument
Next i
End Sub
Private Sub ins_Barcode()
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
objword.Selection.HomeKey(Unit:=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:=WdGoToItem.wdGoToPage, Name:=xname)
HeaderFooterAnzeigen()
insert_Barcode(i)
Textboxesi = Textboxesi + 1
objWord.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekMainDocument
Next i
End Sub
Private Sub HeaderFooterAnzeigen()
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
End Sub
Private Sub insert_Textfield()
Dim Public_barcodeleft
Dim Public_barcodetop
Dim Public_barcodewidth#
Dim Public_barcodeheight
Try
Public_barcodeleft = OfficeVorlage.iBcpl.Value
Public_barcodetop = OfficeVorlage.iBcpt.Value
Public_barcodewidth = OfficeVorlage.iBcw.Value
Public_barcodeheight = OfficeVorlage.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 = Microsoft.Office.Core.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
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
If DokType.bZu_retournieren.Value = True Then
Try
Form = objword.Selection.HeaderFooter.Shapes.Item(Textboxes(Textboxesi))
Form.Select()
Form = objword.Selection.HeaderFooter.Shapes.Item(Textboxes(Textboxesi))
Form.Select()
If OfficeVorlage.bBchorizontal.Value = False Then
objword.ActiveDocument.Tables.Add(Range:=objword.Selection.Range, NumRows:=1, NumColumns:=1)
With objword.Selection.Tables.Item(1)
.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 = WdTextOrientation.wdTextOrientationUpward
objword.Selection.Tables.Item(1).Rows.HeightRule = WdRowHeightRule.wdRowHeightAtLeast
objword.Selection.Tables.Item(1).Rows.Height = Form.height
End If
'gaga'
Dim id As String
id = Dokumentid
s = Bar25I(Microsoft.VisualBasic.Right(Right(id, Len(id) - 6), 16))
objword.Selection.TypeText(Text:=s)
objword.Selection.HomeKey(Unit:=WdUnits.wdLine, Extend:=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:=WdUnits.wdLine)
objword.Selection.Font.Name = "Arial"
objword.Selection.Font.Size = 8
Dim Zeichen As String
Select Case DokType.iPhysisches_archiv.Value
Case 0
Case 1
Zeichen = " U"
Case 2
Zeichen = " F"
End Select
objword.Selection.TypeText(Zeichen)
Form = Nothing
Catch ex As Exception
End Try
End If
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
' Initialize input and output strings
BarTextOut = ""
BarTextIn = RTrim(LTrim(BarTextIn))
' Throw away non-numeric data
TempString = ""
For II = 1 To Len(BarTextIn)
If IsNumeric(Mid(BarTextIn, II, 1)) Then
TempString = TempString & Mid(BarTextIn, II, 1)
End If
Next II
' If not an even number of digits, add a leading 0
If (Len(TempString) Mod 2) = 1 Then
TempString = "0" & TempString
End If
' Break digit pairs up and convert to characters- build output string
For II = 1 To Len(TempString) Step 2
'Break string into pairs of digits and get value
CharValue = Mid(TempString, II, 2)
'translate value to ASCII and save in BarTextOut
If CharValue < 90 Then
BarTextOut = BarTextOut & Chr(CharValue + 33)
Else
BarTextOut = BarTextOut & Chr(CharValue + 71)
End If
Next II
'Build ouput string, trailing space for Windows rasterization bug
barcodeout = "{" & BarTextOut & "} "
'Return the string
Bar25I = barcodeout
End Function
'---------------------------------------------------------------------------
' This function converts a string of digits into a format compatible with Elfring
' Fonts Inc bar codes. It adds the start character, scans and converts digit pairs
' into single ASCII characters, and adds checksum and a stop character. Note that
' non-digits are ignored, and if you enter an even number of digits, a leading zero
' will be added.
'---------------------------------------------------------------------------
Public Function Bar25Ics(ByVal BarTextIn As String) As String
' Initialize input and output strings
BarTextOut = ""
BarTextIn = RTrim(LTrim(BarTextIn))
' Throw away non-numeric data
TempString = ""
For II = 1 To Len(BarTextIn)
If IsNumeric(Mid(BarTextIn, II, 1)) Then
TempString = TempString & Mid(BarTextIn, II, 1)
End If
Next II
' If not an odd number of digits, add a leading 0
If (Len(TempString) Mod 2) = 0 Then
TempString = "0" & TempString
End If
' Figure out the checksum digit
Sum = 0
For II = 1 To Len(TempString)
CharValue = Mid(TempString, II, 1)
If (II Mod 2) = 1 Then
Sum = Sum + (3 * CharValue)
Else
Sum = Sum + CharValue
End If
Next II
' Figure checksum, add it as last digit
CheckSum = 10 - (Sum Mod 10)
If CheckSum = 10 Then CheckSum = 0
TempString = TempString & Chr(48 + CheckSum)
' Break digit pairs up and convert to characters- build output string
For II = 1 To Len(TempString) Step 2
'Break string into pairs of digits and get value
CharValue = Mid(TempString, II, 2)
'translate value to ASCII and save in BarTextOut
If CharValue < 90 Then
BarTextOut = BarTextOut & Chr(CharValue + 33)
Else
BarTextOut = BarTextOut & Chr(CharValue + 71)
End If
Next II
'Build ouput string, trailing space for Windows rasterization bug
barcodeout = "{" & BarTextOut & "} "
'Return the string
Bar25Ics = barcodeout
End Function
#End Region
#Region "IDV_Makros"
Public Function IDV_makros_bearbeiten() As Boolean
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start IDV_makros_bearbeiten", clsDivFnkt.Enum_InfoTyp.Information)
End If
Try
Dim idvmakros As New edokadb.clsMyDokumentDaten()
Dim makros As System.Data.DataTable
Dim i As Long
idvmakros.cpMainConnectionProvider = conn
makros = idvmakros.Select_IDVMakros(DokType.iDokumenttypnr.Value)
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()
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Start IDV_makros_bearbeiten:Makro: " & makros.Rows(i).Item("makro"), clsDivFnkt.Enum_InfoTyp.Information)
End If
objword.Run(makros.Rows(i).Item("makro"))
'System.Windows.Forms.Application.DoEvents()
End If
Catch ex As Exception
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: IDV_makros_bearbeiten:: Fehler beim Makro-Aufruf::" & makros.Rows(i).Item("makro") & "::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
End Try
Next i
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende IDV_makros_bearbeiten (True)", clsDivFnkt.Enum_InfoTyp.Information)
End If
Return True
Catch ex As Exception
DivFnkt.InsertJournale("EDKB12::Fehler:: IDV_makros_bearbeiten::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler)
If Param.DebugMode Then
DivFnkt.InsertJournale("EDKB12: Ende IDV_makros_bearbeiten (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information)
End If
Return False
End Try
End Function
#End Region
End Module
Reference in new issue View Git Blame Copy Permalink