Imports System.IO Imports System.Data Imports System.Data.SqlTypes Imports System.Data.SqlClient Imports Oracle.DataAccess.Client Imports Oracle.DataAccess.Types Imports Microsoft.Office.Interop Imports Microsoft.Office.Core Imports Microsoft.Office Module ModMain #Region "Deklarationen" Dim args As String() = Environment.GetCommandLineArgs() Dim Kundennr As String = "" Dim kundenname As String = "" Dim DepotNr As String = "" Dim Steuerjahr As String = "" Dim DocBegleitbrief As String = "" Dim PSBegleitbrief As String = "" Dim PDFBegleitbrief As String = "" Dim BLStapel As String = "" Dim DocDSR As String = "" Dim PSDSR As String = "" Dim PDFMergeddoc As String = "" Dim IndMergeDoc As String = "" Dim PDFDSR As String = "" Dim doccount As Integer = 0 Dim dokumentid As String = "" Dim blkunde As Boolean = False Dim LogFileOK As String = "" Dim LogFileNOK As String = "" Dim LogFileDebug As String = "" Dim TimeStamp As String = "" Dim partner As New edokaDB.clsPartner Dim Dokumenttyp As New edokadb.clsDokumenttyp Dim OfficeVorlage As New edokadb.clsOffice_vorlage Dim OfficeVorlageDatei As New edokadb.clsOffice_Vorlage_Datei Dim Kopfzeile_generieren As Boolean = False Dim vv As New edokadb.clsVV Dim objword As Word.Application Dim docword As Word.Document Dim edkb08sst As New clsImportdata Dim vorlagendaten As New DataTable Dim OracleAdresse() As String Dim OracleReturn As String Dim meldung As String = "Durch EDOKA wurden für das deutsche Steuerreporting Dokumente generiert" + vbCrLf Dim MeldungFehler As Integer = 0 Dim MeldungOK As Integer = 0 Dim MeldungBL As Integer = 0 Dim counter As Integer = 0 Dim fileextension As String = ".doc" Dim Vorlage_DateiNr As Integer = 0 #End Region Sub Main() Globals.Param = New Parameters Globals.LogData.Rows.Clear() Globals.LogData.AcceptChanges() If Globals.In_Runtime = False Then Exit Sub DivFnkt.InsertJournale("Start EDKB14", clsDivFnkt.Enum_InfoTyp.Information) 'LogEntry.Writelog(Log.Logtype.Debug, "Parameter:") 'LogEntry.Writelog(Log.Logtype.Debug, "Connectionstring EDOKA: " + Param.connectionstring) 'LogEntry.Writelog(Log.Logtype.Debug, "Connectionstring Journale: " + Param.connectionstring_Journale) 'LogEntry.Writelog(Log.Logtype.Debug, "Anz Dokumente:" + Param.AnzDokumente.ToString) 'LogEntry.Writelog(Log.Logtype.Debug, "WorkDir: " + Param.WorkDir) 'LogEntry.Writelog(Log.Logtype.Debug, "DSRDir: " + Param.DSRDir) 'LogEntry.Writelog(Log.Logtype.Debug, "DokType Briefvorlage: " + Param.DokTypeBriefvorlage.ToString) 'LogEntry.Writelog(Log.Logtype.Debug, "PSDir: " + Param.PSDir) 'LogEntry.Writelog(Log.Logtype.Debug, "PDFDir " + Param.PDFDir) 'LogEntry.Writelog(Log.Logtype.Debug, "LogDir: " + Param.LogDir) 'LogEntry.Writelog(Log.Logtype.Debug, "PS Printer :" + Param.PSPrinter) 'LogEntry.Writelog(Log.Logtype.Debug, "Distiller In Out Dirs:" + Param.Use_PDFInOutDir.ToString) 'LogEntry.Writelog(Log.Logtype.Debug, "EDKB08 Dir: " + Param.EDKB08Dir) 'LogEntry.Writelog(Log.Logtype.Debug, "Wait Loop:" + Param.WaitLoop.ToString) 'LogEntry.Writelog(Log.Logtype.Debug, "Oracle ConString: " + Param.OracleConnectionString) 'LogEntry.Writelog(Log.Logtype.Debug, "Adresse aus Oracle: " + Param.AdresseAbOracle.ToString) LogEntry.Writelog(Log.Logtype.Debug, "Start CheckFiles") Dim di As New IO.DirectoryInfo(Globals.Param.DSRDir) Dim aryFi As IO.FileInfo() = di.GetFiles("*.xml") doccount = 0 MeldungFehler = 0 MeldungOK = 0 MeldungBL = 0 While aryFi.Length > 0 LogEntry.Writelog(Log.Logtype.Debug, "Checkfiles: " + aryFi.Length.ToString) Check_Files() aryFi = di.GetFiles("*.xml", SearchOption.TopDirectoryOnly) If Globals.In_Runtime = False Then Exit While End While If MeldungOK > 0 Or MeldungFehler > 0 Then meldung = "Durch EDOKA wurden für das deutsche Steuerreporting Dokumente generiert" + vbCrLf + vbCrLf meldung = meldung + "Dokumente generiert: " + MeldungOK.ToString + vbCrLf + vbCrLf + "Davon banklagernd: " + MeldungBL.ToString + vbCrLf + vbCrLf + "Fehlerhaft: " + MeldungFehler.ToString send_mail() End If DivFnkt.InsertJournale("Ende EDKB14", clsDivFnkt.Enum_InfoTyp.Information) End Sub Private Function Save_Journal() Try Dim sqlstatement As String = "Select * from EDKB14_Protokoll where eintragnr = -1" Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter(sqlstatement, Param.connectionstring_Journale) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim omydata, omydata1, omydata2 As Object Extract_CSV(Globals.LogData, LogFileOK + ".CSV") Dim dsDATEN As New DataSet() Try If IO.File.Exists(LogFileOK) Then Dim fs As New FileStream(LogFileOK + ".CSV", FileMode.Open, FileAccess.Read) Dim mydata(fs.Length) As Byte fs.Read(mydata, 0, fs.Length) fs.Close() omydata = mydata LogEntry.Writelog(Log.Logtype.Debug, "Logfile in omydata") Else Dim mydata(0) As Byte omydata = System.DBNull.Value End If Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, ex.Message) End Try If File.Exists(LogFileNOK) Then Dim fs1 As New FileStream(LogFileNOK, FileMode.Open, FileAccess.Read) Dim mydata1(fs1.Length) As Byte fs1.Read(mydata1, 0, fs1.Length) fs1.Close() omydata1 = mydata1 Else Dim mydata1(0) As Byte omydata1 = System.DBNull.Value End If If File.Exists(BLStapel) Then Dim fs2 As New FileStream(BLStapel, FileMode.Open, FileAccess.Read) Dim mydata2(fs2.Length) As Byte fs2.Read(mydata2, 0, fs2.Length) fs2.Close() omydata2 = mydata2 Else omydata2 = System.DBNull.Value End If Try Connection.ConnectionString = Param.connectionstring_Journale Connection.Open() DA.Fill(dsDATEN, "docs") Dim myRow As DataRow If dsDATEN.Tables(0).Rows.Count = 0 Then myRow = dsDATEN.Tables(0).NewRow myRow.Item(1) = Now myRow.Item(2) = omydata myRow.Item(3) = omydata1 myRow.Item(4) = omydata2 dsDATEN.Tables(0).Rows.Add(myRow) DA.Update(dsDATEN, "docs") End If Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, ex.Message) End Try cb = Nothing dsDATEN = Nothing DA = Nothing Connection.Close() Connection = Nothing Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, ex.Message) End Try End Function Private Sub Extract_CSV(ByVal dt As DataTable, ByVal filename As String) Dim s As String Dim i As Integer Dim c As Integer Dim tw As TextWriter tw = New StreamWriter(New FileStream(filename, FileMode.Create)) s = "" For i = 0 To dt.Columns.Count - 1 s = s + dt.Columns(i).ColumnName + ";" Next tw.WriteLine(s) s = "" For i = 0 To dt.Rows.Count - 1 For c = 0 To dt.Columns.Count - 1 Try s = s + CType(dt.Rows(i).Item(c), String) + ";" Catch s = s + "" End Try Next tw.WriteLine(s) s = "" Next tw.Flush() tw.Close() End Sub Private Function Check_Files() Dim di As New IO.DirectoryInfo(Globals.Param.DSRDir) Dim aryFi As IO.FileInfo() = di.GetFiles("*.xml") Dim fi1 As IO.FileInfo TimeStamp = Format(Now, "ddMMyyyy hhmmss") BLStapel = Param.WorkDir + TimeStamp + "_BLStapel.pdf" LogFileOK = Param.LogDir + Format(Now, "ddMMyyyy hhmmss") + "_OK.txt" LogFileNOK = Param.LogDir + Format(Now, "ddMMyyyy hhmmss") + "_NOK.txt" LogEntry.set_file_names(LogFileOK, LogFileNOK) objword = New Word.Application If Param.DebugMode = True Then objword.Visible = True ' MsgBox("Word gestartet") ' objword.Visible = False End If Counter = 0 For Each fi1 In aryFi counter = counter + 1 If counter > Globals.Param.AnzDokumente Then LogEntry.Writelog(Log.Logtype.Debug, "Exit for: " + IndMergeDoc) Exit For End If If Globals.In_Runtime = False Then LogEntry.Writelog(Log.Logtype.Debug, "Exit for - Zeit abgelaufen: " + IndMergeDoc) Exit For End If LogEntry.Writelog(Log.Logtype.Debug, "--------->" + fi1.FullName) If open_xml_as_textfile(fi1.FullName) = False Then Close_Word() Try IO.File.Move(fi1.FullName, fi1.FullName + ".failed") MeldungFehler = MeldungFehler + 1 wait(3) Catch End Try Exit Function End If doccount = doccount + 1 Get_Office_Vorlage(True) LogEntry.Writelog(Log.Logtype.Debug, "Check_FileExtension Start") If Param.CheckOffice2010 = False Then fileextension = ".doc" Else Select Case check_office_2010_appl(Vorlage_DateiNr) Case 0 fileextension = ".doc" Case 4 fileextension = ".docx" Case 5 fileextension = ".docm" Case 6 fileextension = ".dotx" Case 7 fileextension = ".dotm" Case Else fileextension = ".doc" End Select End If LogEntry.Writelog(Log.Logtype.Debug, "Check_FileExtension Ende: " + fileextension) TimeStamp = Format(Now, "ddMMyyyy hhmmss") DocBegleitbrief = Param.WorkDir + partner.iNRPAR00.ToString + "_" + TimeStamp + "_Doc" + fileextension DocDSR = Param.WorkDir + partner.iNRPAR00.ToString + "_" + TimeStamp + "_DSR" + fileextension If Param.Use_PDFInOutDir = True Then PSBegleitbrief = Param.PSDir + "in\" + partner.iNRPAR00.ToString + "_" + TimeStamp + "_Doc.ps" PDFBegleitbrief = Param.PDFDir + "out\" + partner.iNRPAR00.ToString + "_" + TimeStamp + "_Doc.PDF" PSDSR = Param.PSDir + "in\" + partner.iNRPAR00.ToString + "_" + TimeStamp + "_DSR.ps" PDFDSR = Param.PDFDir + "out\" + partner.iNRPAR00.ToString + "_" + TimeStamp + "_DSR.PDF" PDFMergeddoc = Param.PDFDir + "out\" + partner.iNRPAR00.ToString + "_" + TimeStamp + "_Merged.pdf" IndMergeDoc = Param.PDFDir + "out\" + partner.iNRPAR00.ToString + "_" + TimeStamp.ToString + "_merged.IND" Else PSBegleitbrief = Param.PSDir + partner.iNRPAR00.ToString + "_" + TimeStamp + "_Doc.ps" PDFBegleitbrief = Param.PDFDir + partner.iNRPAR00.ToString + "_" + TimeStamp + "_Doc.PDF" PSDSR = Param.PSDir + partner.iNRPAR00.ToString + "_" + TimeStamp + "_DSR.ps" PDFDSR = Param.PDFDir + partner.iNRPAR00.ToString + "_" + TimeStamp + "_DSR.PDF" PDFMergeddoc = Param.PDFDir + partner.iNRPAR00.ToString + "_" + TimeStamp + "_Merged.pdf" IndMergeDoc = Param.PDFDir + partner.iNRPAR00.ToString + "_" + TimeStamp.ToString + "_merged.ind" End If LogEntry.Writelog(Log.Logtype.Debug, "--> " + Now.ToString + " <---------------------------------------------------------------") LogEntry.Writelog(Log.Logtype.Debug, "Word Begleitbrief: " + DocBegleitbrief) LogEntry.Writelog(Log.Logtype.Debug, "PS Begleitbrief: " + PSBegleitbrief) LogEntry.Writelog(Log.Logtype.Debug, "PDF Begleitbrief: " + PDFBegleitbrief) LogEntry.Writelog(Log.Logtype.Debug, "DOC DSR-Dokument: " + DocDSR) LogEntry.Writelog(Log.Logtype.Debug, "PS DSR-Dokument: " + PSDSR) LogEntry.Writelog(Log.Logtype.Debug, "PDF DSR-Dokument: " + PDFDSR) LogEntry.Writelog(Log.Logtype.Debug, "PDF Merged: " + PDFMergeddoc) LogEntry.Writelog(Log.Logtype.Debug, "Index Merged: " + IndMergeDoc) Dim Generierung_done As Boolean = False If Get_Office_Vorlage() = True Then dokumentid = "" If Generate_Begleitbrief() Then Generate_XML_Dokument(fi1.FullName) If PDFExists() Then If Merge_Doc() Then LogEntry.Writelog(Log.Logtype.Debug, "Export-Daten erstellen") If edkb08sst.Importdaten_erstellen(partner.iNRPAR00.ToString, Param.DokTypeBriefvorlage.ToString, PDFMergeddoc, IndMergeDoc, Param.EDKB08Dir, dokumentid, blkunde) Then LogEntry.Writelog(Log.Logtype.Debug, "Export-Daten erstellen ende") Generierung_done = True Try LogEntry.Writelog(Log.Logtype.Debug, "Rename Start") IO.File.Move(fi1.FullName, fi1.FullName + ".done") LogEntry.Writelog(Log.Logtype.Debug, "Rename Ende") Catch End Try deletefile(DocBegleitbrief) deletefile(PDFDSR) deletefile(PSBegleitbrief) deletefile(PSDSR) deletefile(PDFBegleitbrief) deletefile(PDFMergeddoc) deletefile(IndMergeDoc) End If End If End If End If End If If Generierung_done Then MeldungOK = MeldungOK + 1 LogEntry.Writelog(Log.Logtype.OK, "Dokument für Partner " + partner.iNRPAR00.ToString + " / " + " erstellt") Dim dt As DataRow = Globals.LogData.NewRow dt.Item(0) = Now.ToString dt.Item(1) = partner.iNRPAR00.ToString dt.Item(2) = Kundennr If blkunde = True Then MeldungBL = MeldungBL + 1 dt.Item(3) = "Ja" Else dt.Item(3) = "Nein" End If Globals.LogData.Rows.Add(dt) Else MeldungFehler = MeldungFehler + 1 LogEntry.Writelog(Log.Logtype.OK, "Dokument für Partner " + partner.iNRPAR00.ToString + " / " + " nicht erstellt - vgl. Fehlerprotokoll") Try IO.File.Move(fi1.FullName, fi1.FullName + ".failed") Catch End Try deletefile(DocBegleitbrief) deletefile(PDFDSR) deletefile(PSBegleitbrief) deletefile(PSDSR) deletefile(PDFBegleitbrief) deletefile(PDFMergeddoc) deletefile(IndMergeDoc) End If System.Threading.Thread.CurrentThread.Sleep(2000) Next LogEntry.Writelog(Log.Logtype.OK, "Close Word: ") Close_Word() LogEntry.Writelog(Log.Logtype.OK, "Anzahl generierte Dokumente: " + doccount.ToString) Save_Journal() End Function Private Sub deletefile(ByVal filename As String) Try IO.File.Delete(filename) Catch ex As Exception End Try End Sub #Region "Word" Private Sub Close_Word() Try 'objword.Visible = True objword.Quit(SaveChanges:=False) objword = Nothing Catch ex As Exception End Try End Sub Private Function Get_Office_Vorlage(Optional ByVal OnlyNr As Boolean = False) As Boolean Try LogEntry.Writelog(Log.Logtype.Debug, "Office Vorlage auslesen Start") Dokumenttyp.iDokumenttypnr = New SqlInt32(CType(Param.DokTypeBriefvorlage, Int32)) Dokumenttyp.cpMainConnectionProvider = Globals.conn Dokumenttyp.SelectOne() OfficeVorlage.cpMainConnectionProvider = Globals.conn conn.OpenConnection() OfficeVorlage.iOffice_vorlagenr = New SqlInt32(Dokumenttyp.iOffice_vorlagenr.Value) OfficeVorlage.SelectOne() conn.CloseConnection(True) Kopfzeile_generieren = OfficeVorlage.bKopfzeile_generieren.Value Vorlage_DateiNr = OfficeVorlage.iOffice_vorlagenr.Value If OnlyNr Then LogEntry.Writelog(Log.Logtype.Debug, "Office Vorlage auslesen Nr. Ende") OfficeVorlage.Dispose() Return True End If If Office_Vorlage_Get_From_DB(OfficeVorlage.iOffice_vorlagenr.Value, DocBegleitbrief) = "" Then Return False End If OfficeVorlage.Dispose() LogEntry.Writelog(Log.Logtype.Debug, "Office Vorlage auslesen Ende") Return True Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, "Office Vorlage auslesen fehlgeschlagen: " + ex.Message) LogEntry.Writelog(Log.Logtype.NOK, "Office Vorlage auslesen fehlgeschlagen: " + ex.Message) Return False End Try End Function Private Function Generate_XML_Dokument(ByVal Dokumentname As String) LogEntry.Writelog(Log.Logtype.Debug, "DSR Dokument öffnen und drucken Start") Try objword.Visible = True objword.Documents.Open(Dokumentname) Threading.Thread.CurrentThread.Sleep(500) docword = objword.ActiveDocument Threading.Thread.CurrentThread.Sleep(500) objword.Visible = True Threading.Thread.CurrentThread.Sleep(500) Dim outputfile As String outputfile = UCase(PDFDSR) docword.ExportAsFixedFormat(outputfile.ToString, Word.WdExportFormat.wdExportFormatPDF) ' Dim w As New Microsoft.Office.Interop.Word.Application ' w.Documents.Open(FileName:=SourceFilename.ToString, ReadOnly:=True) ' ' w.ActiveDocument.ExportAsFixedFormat(Outputfile.ToString, Word.WdExportFormat.wdExportFormatPDF) ' ' objword.ActivePrinter = Param.PSPrinter ' docword.PrintOut(OutputFileName:=PSDSR, PrintToFile:=False, Copies:=1) 'If Param.ConvertPDFDirect = True Then ' If Param.Use_PDFInOutDir <> True Then ' wait(10) ' Process.Start(PSDSR) ' End If 'End If docword.Close(SaveChanges:=False) Return True Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, "DSR Dokument öffnen und drucken fehlgeschlagen: " + ex.Message) LogEntry.Writelog(Log.Logtype.NOK, "DSR Dokument öffnen und drucken fehlgeschlagen: " + ex.Message) Return False End Try End Function #End Region #Region "Acrobat" Private Function Merge_Doc() As Boolean LogEntry.Writelog(Log.Logtype.Debug, "PDF-Dokumente zusammenführen start") Dim f1 As Acrobat.CAcroPDDoc Dim f2 As Acrobat.CAcroPDDoc Try Dim i As Integer f1 = CreateObject("AcroExch.PDDoc") f2 = CreateObject("AcroExch.PDDoc") i = f1.Open(PDFDSR) If i <> 0 Then LogEntry.Writelog(Log.Logtype.Debug, "MergeDoc: 1") i = f2.Open(PDFBegleitbrief) If i <> 0 Then LogEntry.Writelog(Log.Logtype.Debug, "MergeDoc: 2") i = f1.InsertPages(-1, f2, 0, f2.GetNumPages, 1) If i <> 0 Then LogEntry.Writelog(Log.Logtype.Debug, "MergeDoc: 3") i = f1.Save(Acrobat.PDSaveFlags.PDSaveFull, PDFMergeddoc) If i <> 0 Then LogEntry.Writelog(Log.Logtype.Debug, "MergeDoc: 4") f1.Close() f2.Close() LogEntry.Writelog(Log.Logtype.Debug, "PDF-Dokumente zusammenführen Ende") If blkunde Then LogEntry.Writelog(Log.Logtype.Debug, "BL-Trennblatt hinzufügen Start") If IO.File.Exists(BLStapel) Then i = f1.Open(BLStapel) If i <> 0 Then LogEntry.Writelog(Log.Logtype.Debug, "MergeDoc: 5") i = f2.Open(Param.WorkDir + "\Trennblatt.pdf") If i <> 0 Then LogEntry.Writelog(Log.Logtype.Debug, "MergeDoc: 6") i = f1.InsertPages(-1, f2, 0, f2.GetNumPages, 1) If i <> 0 Then LogEntry.Writelog(Log.Logtype.Debug, "MergeDoc: 7") f2.Close() i = f2.Open(PDFMergeddoc) If 8 <> 0 Then LogEntry.Writelog(Log.Logtype.Debug, "MergeDoc: 1") i = f1.InsertPages(-1, f2, 0, f2.GetNumPages, 1) If i <> 0 Then LogEntry.Writelog(Log.Logtype.Debug, "MergeDoc: 9") i = f1.Save(Acrobat.PDSaveFlags.PDSaveFull, BLStapel) If i <> 0 Then LogEntry.Writelog(Log.Logtype.Debug, "MergeDoc: 10") f1.Close() f2.Close() Else IO.File.Copy(PDFMergeddoc, BLStapel) End If LogEntry.Writelog(Log.Logtype.Debug, "BL-Trennblatt hinzufügen Ende") End If Return True Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, "PDF-Dokumente konnten nicht zusammengeführr werden: " + ex.Message) Return False Finally f1 = Nothing f2 = Nothing End Try End Function Private Function PDFExists() As Boolean Dim timestampend As DateTime = Now LogEntry.Writelog(Log.Logtype.Debug, "Wait-Loop initialisiert - " + Param.WaitLoop.ToString + " Minuten -" + TimeStamp.ToString) timestampend = timestampend.AddMinutes(Param.WaitLoop) While Now < timestampend wait(2) If IO.File.Exists(PDFBegleitbrief) And IO.File.Exists(PDFDSR) Then LogEntry.Writelog(Log.Logtype.Debug, "PDFs erstellt - " + Now.ToString) wait(5) Return True End If End While LogEntry.Writelog(Log.Logtype.Debug, "PDFs wurden nicht erstellt.") Return False End Function #End Region #Region "XML-Bearbeitung" Private Function open_xml_as_textfile(ByVal filename As String) As Boolean Try LogEntry.Writelog(Log.Logtype.Debug, "XML-Dokument öffenen und Kundenummer auslesen start") FileOpen(1, filename, OpenMode.Input) Dim s As String Kundennr = "" kundenname = "" Steuerjahr = "" DepotNr = "" While Not EOF(1) Input(1, s) If s.IndexOf("Berichtszeitraum:") > 0 Then Steuerjahr = s.Substring(s.IndexOf("Berichtszeitraum:") + 24, 4) LogEntry.Writelog(Log.Logtype.Debug, "Steuerjahr: " + Steuerjahr.ToString) End If 'LogEntry.Writelog(Log.Logtype.Debug, s) 'If s.IndexOf("Depot-Nr.") > 0 Then If s.IndexOf("Nr.") > 0 Then 'Kundennr = s.Substring(s.IndexOf("DepotNr") + 8, 15) Kundennr = s.Substring(s.IndexOf("Nr.") + 8, 15) DepotNr = Kundennr Kundennr = Kundennr.Substring(1, 4) + Kundennr.Substring(6, 4) + Kundennr.Substring(11, 4) If Check_Partner(Kundennr) = False Then LogEntry.Writelog(Log.Logtype.NOK, "Partner: " + Kundennr + " nicht vorhanden") 'DivFnkt.InsertJournale("EDKB14: Partner " + Kundennr + " nicht vorhanden.", clsDivFnkt.Enum_InfoTyp.Fehler) FileClose(1) Return False End If FileClose(1) If Param.AdresseAbOracle = True Then LogEntry.Writelog(Log.Logtype.Debug, "DepotNr für Oracladresse: " + DepotNr.ToString) If get_oracle_adresse(Trim(DepotNr.ToString)) = False Then LogEntry.Writelog(Log.Logtype.NOK, "Oracle-Adresse: " + DepotNr + " nicht vorhanden") 'DivFnkt.InsertJournale("EDKB14: Partner " + Kundennr + " nicht vorhanden.", clsDivFnkt.Enum_InfoTyp.Fehler) FileClose(1) Return False End If End If LogEntry.Writelog(Log.Logtype.Debug, "-->Partner<--") LogEntry.Writelog(Log.Logtype.Debug, "Kundenummer: " + partner.iNRPAR00.ToString) LogEntry.Writelog(Log.Logtype.Debug, "Depot-Nummer: " + DepotNr) LogEntry.Writelog(Log.Logtype.Debug, "Steuerjahr: " + Steuerjahr.ToString) vorlagendaten.Rows.Clear() vorlagendaten = Get_Vorlagendaten() For Each dr As DataRow In vorlagendaten.Rows If dr.Item("beginntextmarke") = "TGEDKVornameNameInhaberB" Then kundenname = dr.Item("Inhalt").ToString End If Next change_XML_Document(filename) Return True End If End While LogEntry.Writelog(Log.Logtype.Debug, "Kundennummer konnte nicht gefunden werden.") LogEntry.Writelog(Log.Logtype.NOK, filename + " Kundennummer nicht gefunden.") Try FileClose(1) Catch ex As Exception End Try Return False Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, "XML-Dokument öffenen und Kundenummer auslesen Fehler: " + ex.Message) LogEntry.Writelog(Log.Logtype.NOK, "XML-Dokument öffenen und Kundenummer auslesen Fehler: " + ex.Message) Finally Try FileClose(1) Catch ex As Exception End Try End Try LogEntry.Writelog(Log.Logtype.Debug, "XML-Dokument öffenen und Kundenummer auslesen ende") End Function Private Function check_blkunde(ByVal nrpar00 As Integer) As Boolean Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandText = "dbo.sp_edex_bl_check_blkunde" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try scmCmdToExecute.Connection = conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@nrpar00", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, nrpar00)) scmCmdToExecute.Parameters.Add(New SqlParameter("@blkunde", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) sdaAdapter.Fill(dtToReturn) If scmCmdToExecute.Parameters("@blkunde").Value = 0 Then Return False Else Return True End If Catch ex As Exception Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() dtToReturn.Dispose() End Try End Function Public Function change_XML_Document(ByVal filename As String) Try Dim w As StreamWriter = New StreamWriter(filename + ".tmp") Dim r As StreamReader = New StreamReader(filename) Dim line As String line = r.ReadToEnd line = line.Replace("#Vorname# #Name#", kundenname) 'line = line.Replace("18.04.2011", "03.05.2011") w.Write(line) w.Flush() 'line = r.ReadLine 'Do While (Not line Is Nothing) ' line = line.Replace("#Vorname# #Name#", kundenname) ' w.WriteLine(line) ' line = r.ReadLine 'Loop r.Close() w.Close() IO.File.Move(filename, filename + "_" + TimeStamp + ".ori") IO.File.Move(filename + ".tmp", filename) Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, "XML ersetzen Fehlgeschlagen") End Try End Function #End Region #Region "DB-Zugriffe" Private Function Check_Partner(ByVal Kundennr As String) As Boolean Dim nrpar00 As Integer = Get_VVPartner("" + Kundennr) If nrpar00 = -1 Then LogEntry.Writelog(Log.Logtype.Debug, "Parnter aus VV " + Kundennr + " nicht gefunden") LogEntry.Writelog(Log.Logtype.NOK, "Parnter aus VV " + Kundennr + " nicht gefunden") Return False End If partner.cpMainConnectionProvider = Globals.conn partner.iNRPAR00 = New SqlInt32(CType(nrpar00, Int32)) Dim dt As New DataTable dt = partner.SelectOne() If dt.Rows.Count = 0 Then Return False Else If check_blkunde(partner.iNRPAR00.Value) = True Then blkunde = True Else blkunde = False Return True End If End Function Public Function Office_Vorlage_Get_From_DB(ByVal office_vorlagenr As Integer, ByVal Filename As String) As String Dim sql As String sql = "Select * From office_vorlage_datei where office_vorlage_Dateinr=" + Trim(Str(office_vorlagenr)) 'Office 2010-Extension' If fileextension.Length > 4 Then sql = "Select * From Office2010_Vorlage_datei where office_vorlage_Dateinr=" + Trim(Str(office_vorlagenr)) End If LogEntry.Writelog(Log.Logtype.Debug, "Start Office_Vorlage_Get_From_DB") Dim connection As New SqlConnection() Dim da As New SqlDataAdapter(sql, 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 LogEntry.Writelog(Log.Logtype.Debug, "Ende GOffice_Vorlage_Get_From_DB (true):" + Filename) Return Filename Catch ex As Exception LogEntry.Writelog(Log.Logtype.NOK, "Fehler:: Office_Vorlage_Get_From_DB::" & ex.Message) LogEntry.Writelog(Log.Logtype.Debug, "Fehler:: Office_Vorlage_Get_From_DB::" & ex.Message) Return "" End Try CB = Nothing ds = Nothing da = Nothing connection.Close() connection = Nothing End Function Public Function Generate_Key() As String Dim dbkey As New edokadb.clsMyKey_Tabelle() Dim key As Long Dim skey As String Dim s As String dbkey.cpMainConnectionProvider = conn conn.OpenConnection() key = dbkey.get_dbkey("dokument") conn.CloseConnection(False) skey = "OFFEDK000" s = Str(Year(Now)) While Microsoft.VisualBasic.Left(s, 1) = " " s = Microsoft.VisualBasic.Right(s, Len(s) - 1) End While skey = skey + s s = Str(key) While Microsoft.VisualBasic.Left(s, 1) = " " s = Microsoft.VisualBasic.Right(s, Len(s) - 1) End While While Len(s) < 8 s = "0" + s End While skey = skey + s s = Pruefziffer(Microsoft.VisualBasic.Right(skey, 15)) While Microsoft.VisualBasic.Left(s, 1) = " " s = Microsoft.VisualBasic.Right(s, Len(s) - 1) End While skey = skey + s Generate_Key = skey End Function Public Function Get_Vorlagendaten() As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) scmCmdToExecute.CommandText = "dbo.edkb14_vorlagenfelder" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = Globals.conn.scoDBConnection Try scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttypnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Param.DokTypeBriefvorlage)) scmCmdToExecute.Parameters.Add(New SqlParameter("@partnernr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, partner.iNRPAR00.Value)) sdaAdapter.Fill(dtToReturn) Return dtToReturn Catch ex As Exception Throw New Exception("sp_check_dokumentreaktivierung::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() End Try End Function Private Function Get_VVPartner(ByVal nevvg00 As String) As Integer Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) scmCmdToExecute.CommandText = "dbo.SP_Edoka_Import_get_vvPartner" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = Globals.conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@nevvg00", SqlDbType.VarChar, 16, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, nevvg00)) scmCmdToExecute.Parameters.Add(New SqlParameter("@nrpar00", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) Try conn.OpenConnection() scmCmdToExecute.ExecuteNonQuery() Return scmCmdToExecute.Parameters("@nrpar00").Value Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, "Fehler bei Partner aus VV: " + nevvg00 + " " + ex.Message) LogEntry.Writelog(Log.Logtype.NOK, "Fehler bei Partner aus VV: " + nevvg00 + " " + ex.Message) Return -1 Finally conn.CloseConnection(True) scmCmdToExecute.Dispose() sdaAdapter.Dispose() dtToReturn.Dispose() End Try End Function Private Function send_mail() As Boolean Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim dtToReturn As DataTable = New DataTable() scmCmdToExecute.CommandText = "dbo.sp_sendmail" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = Globals.conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@email", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.Param.Mailadresse)) scmCmdToExecute.Parameters.Add(New SqlParameter("@betreff", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, "EDOKA Deutsches Steuerreporting")) scmCmdToExecute.Parameters.Add(New SqlParameter("@meldung", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, meldung)) Try conn.OpenConnection() scmCmdToExecute.ExecuteNonQuery() Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, "Fehler beim Mailversand: " + ex.Message) LogEntry.Writelog(Log.Logtype.NOK, "Fehler beim Mailversand: " + ex.Message) Return -1 Finally conn.CloseConnection(True) scmCmdToExecute.Dispose() dtToReturn.Dispose() End Try End Function #End Region #Region "Begleitbreif" Private Function Generate_Begleitbrief() LogEntry.Writelog(Log.Logtype.Debug, "Begleitbrief erstellen start:" + DocBegleitbrief) Try objword.Documents.Open(DocBegleitbrief) docword = objword.ActiveDocument If Kopfzeile_generieren Then Insert_Kopfzeile() End If For Each dc As DataRow In vorlagendaten.Rows Dim value As String = "" If Param.AdresseAbOracle = True And dc.Item("beginntextmarke").ToString = "TGEDKAdresseZustellungB99" And blkunde = False Then Dim i As Integer = 0 For i = OracleAdresse.Length To 2 Step -1 If OracleAdresse(i - 1).ToString.Trim <> "" Then value = OracleAdresse(i - 1).ToString + vbCrLf + value Else Exit For End If Next objword.ActiveDocument.Bookmarks.Item(dc.Item("beginntextmarke").ToString).Select() objword.Selection.Text = value Else Insert_Value(dc) End If Next Try objword.ActiveDocument.Bookmarks.Item("EDKB14_Jahr1").Select() objword.Selection.Text = Steuerjahr + " " Catch ex As Exception 'LogEntry.Writelog(Log.Logtype.Debug, "Dokumnet befüllen Fehler: " + ex.Message) End Try Try objword.ActiveDocument.Bookmarks.Item("EDKB14_Jahr2").Select() objword.Selection.Text = Steuerjahr Catch ex As Exception 'LogEntry.Writelog(Log.Logtype.Debug, "Dokumnet befüllen Fehler: " + ex.Message) End Try HeaderFooterAnzeigen() Try objword.ActiveDocument.Bookmarks.Item("TGEDKDepotNrB").Select() objword.Selection.Text = DepotNr Catch ex As Exception 'LogEntry.Writelog(Log.Logtype.Debug, "Dokumnet befüllen Fehler: " + ex.Message) End Try Try Dim pos1 As Integer = 0 Dim Pos2 As Integer = 0 pos1 = objword.ActiveDocument.Bookmarks.Item("TGEDKVornameNameInhaberB").Start Pos2 = objword.ActiveDocument.Bookmarks.Item("TGEDKVornameNameInhaberE").Start objword.Selection.SetRange(Start:=pos1, End:=Pos2) ' objword.ActiveDocument.Bookmarks.Item("TGEDKVornameNameInhaberB").Select() objword.Selection.TypeText(Text:=kundenname) Catch ex As Exception 'LogEntry.Writelog(Log.Logtype.Debug, "Dokumnet befüllen Fehler: " + ex.Message) End Try objword.Visible = True If blkunde = True Then dokumentid = Generate_Key() Generate_Barcodes() End If objword.ActivePrinter = Param.PSPrinter LogEntry.Writelog(Log.Logtype.Debug, "Print: " + PSBegleitbrief) Dim outputfile As String outputfile = UCase(PDFBegleitbrief) docword.ExportAsFixedFormat(outputfile.ToString, Word.WdExportFormat.wdExportFormatPDF) ' docword.PrintOut(OutputFileName:=PSBegleitbrief, PrintToFile:=False, Copies:=1) 'docword.Close(SaveChanges:=False) objword.ActiveDocument.Close(SaveChanges:=False) LogEntry.Writelog(Log.Logtype.Debug, "Word geschlossen: offene Dokumente: " + objword.Documents.Count.ToString) If Param.ConvertPDFDirect = True Then If Param.Use_PDFInOutDir <> True Then wait(5) Process.Start(PSBegleitbrief) End If End If LogEntry.Writelog(Log.Logtype.Debug, "Begleitbrief erstellen Ende") Return True Catch ex As Exception LogEntry.Writelog(Log.Logtype.Debug, "Begleitbrief erstellen Fehler: " + ex.Message) Return False End Try End Function Private Function wait(ByVal sec As Integer) Dim ts As DateTime = Now ts = ts.AddSeconds(sec) While Now < ts System.Threading.Thread.Sleep(1000) End While End Function Private Sub Insert_Value(ByVal dc As DataRow) Dim pos1 As Integer Dim pos2 As Integer LogEntry.Writelog(Log.Logtype.Debug, "Dokumnet befüllen: " + dc.Item("beginntextmarke").ToString + " Inhalt: " + dc.Item("Inhalt")) If dc.Item("beginntextmarke").ToString <> "" And dc.Item("endetextmarke").ToString = "" Then Try objword.ActiveDocument.Bookmarks.Item(dc.Item("beginntextmarke").ToString).Select() objword.Selection.Text = dc.Item("Inhalt") Catch ex As Exception 'LogEntry.Writelog(Log.Logtype.Debug, "Dokumnet befüllen Fehler: " + ex.Message) End Try End If If dc.Item("beginntextmarke").ToString <> "" And dc.Item("endetextmarke").ToString <> "" Then Try pos1 = objword.ActiveDocument.Bookmarks.Item(dc.Item("beginntextmarke").ToString).Start pos2 = objword.ActiveDocument.Bookmarks.Item(dc.Item("endetextmarke").ToString).Start objword.Selection.SetRange(Start:=pos1, End:=pos2) objword.Selection.TypeText(Text:=dc.Item("Inhalt").ToString) Catch ex As Exception 'LogEntry.Writelog(Log.Logtype.Debug, "Dokumnet befüllen Fehler: " + ex.Message) End Try End If End Sub #End Region #Region "WordCommands" Private Sub insert_Barcode(ByVal x As Integer) Dim Form As Word.Shape Dim s As String 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(Word.WdBorderType.wdBorderLeft).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderRight).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderTop).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderBottom).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderDiagonalDown).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Item(Word.WdBorderType.wdBorderDiagonalUp).LineStyle = Word.WdLineStyle.wdLineStyleNone .Borders.Shadow = False End With objword.Selection.Orientation = Word.WdTextOrientation.wdTextOrientationUpward objword.Selection.Tables.Item(1).Rows.HeightRule = Word.WdRowHeightRule.wdRowHeightAtLeast objword.Selection.Tables.Item(1).Rows.Height = Form.Height End If 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:=Word.WdUnits.wdLine, Extend:=Word.WdMovementType.wdExtend) objword.Selection.Font.Name = "Bar 25i c HR" 'Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("barcode_font") objword.Selection.Font.Size = 26 'Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("bcfont_groesse") objword.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphRight objword.Selection.EndKey(Unit:=Word.WdUnits.wdLine) objword.Selection.Font.Name = "Arial" objword.Selection.Font.Size = 8 Dim Zeichen As String If Dokumenttyp.bZu_retournieren.Value = True Then Dim dokt As New edokadb.clsDokumenttyp() dokt.cpMainConnectionProvider = Globals.conn dokt.iDokumenttypnr = New SqlInt32(CType(Dokumenttyp.iDoktypbedingteretournierung.Value, Int32)) dokt.SelectOne() If dokt.iPhysisches_archiv.Value = 2 Then 'EDEX Banklagernd Zeichen = " F" 'objWord.Selection.TypeText(" F") Else Zeichen = " U" 'objWord.Selection.TypeText(" U") End If dokt.Dispose() Else If Dokumenttyp.iPhysisches_archiv.Value = 2 Then Zeichen = " F" ' objWord.Selection.TypeText(" F") Else Zeichen = " U" 'objWord.Selection.TypeText(" U") End If End If Try If blkunde = True Then Zeichen = Zeichen + "/B" End If Catch If blkunde = True Then Zeichen = Zeichen + "/B" End If End Try objword.Selection.TypeText(Zeichen) Form = Nothing Catch ex As Exception End Try End Sub Private Sub ins_Barcode() Dim xname As Object Dim i As Integer Dim pages As Long pages = objword.ActiveDocument.BuiltInDocumentProperties("NUMBER OF PAGES").value objword.Selection.HomeKey(Unit:=Word.WdUnits.wdStory) Textboxesi = 1 For i = 1 To pages xname = Str(i) If Left(xname, 1) = " " Then xname = Right(xname, Len(xname) - 1) objword.Selection.GoTo(What:=Word.WdGoToItem.wdGoToPage, Name:=xname) HeaderFooterAnzeigen() insert_Barcode(i) Textboxesi = Textboxesi + 1 objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekMainDocument Next i End Sub Private Sub HeaderFooterAnzeigen() If objword.ActiveWindow.View.SplitSpecial <> Word.WdSpecialPane.wdPaneNone Then objword.ActiveWindow.Panes.Item(2).Close() End If If objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdNormalView Or objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdOutlineView Then objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdPrintView End If objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekCurrentPageHeader If objword.Selection.HeaderFooter.IsHeader = True Then objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekCurrentPageFooter Else objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekCurrentPageHeader End If End Sub Dim Textboxes(100) As String Dim Textboxesi As Integer Private Sub insert_Textfield() Dim Public_barcodeleft As Integer Dim Public_barcodetop As Integer Dim Public_barcodewidth# Dim Public_barcodeheight As Integer Try Public_barcodeleft = 260 Public_barcodetop = 794 Public_barcodewidth = 300 Public_barcodeheight = 33 HeaderFooterAnzeigen() objword.Selection.HeaderFooter.Shapes.AddTextbox(1, Public_barcodeleft, Public_barcodetop, _ Public_barcodewidth#, Public_barcodeheight).Select() objword.Selection.ShapeRange.Line.Visible = MsoTriState.msoFalse 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 Exit Sub Catch ex As Exception End Try End Sub Private Sub Generate_Barcodes() Insert_TextFelder() ins_Barcode() End Sub Private Sub Insert_TextFelder() Dim xname As Object Dim i As Integer Dim pages As Long pages = objword.ActiveDocument.BuiltInDocumentProperties("NUMBER OF PAGES").value Textboxesi = 1 objword.Selection.HomeKey(Unit:=Word.WdUnits.wdStory) For i = 1 To pages xname = Str(i) If Left(xname, 1) = " " Then xname = Right(xname, Len(xname) - 1) objword.Selection.GoTo(What:=Word.WdGoToItem.wdGoToPage, Name:=xname) insert_Textfield() objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekMainDocument Next i End Sub Private Sub Insert_Kopfzeile() objword.Selection.HomeKey(Unit:=Word.WdUnits.wdStory) If objword.ActiveWindow.View.SplitSpecial <> Word.WdSpecialPane.wdPaneNone Then objword.ActiveWindow.Panes.Item(2).Close() End If If objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdNormalView Or objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdOutlineView Then objword.ActiveWindow.ActivePane.View.Type = Word.WdViewType.wdPrintView End If objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekCurrentPageHeader set_headerbookmark() objword.ActiveWindow.ActivePane.View.SeekView = Word.WdSeekView.wdSeekMainDocument End Sub Private Sub set_headerbookmark() Try objword.ActiveDocument.Bookmarks.Item("TGEDKCompanyBBEB99").Select() Catch objword.Selection.MoveDown(Unit:=Word.WdUnits.wdLine, Count:=1) With objword.ActiveDocument.Bookmarks .Add(Range:=objword.Selection.Range, Name:="TGEDKCompanyBBEB99") .DefaultSorting = Word.WdBookmarkSortBy.wdSortByName .ShowHidden = False End With End Try 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 As String 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 Public Function Pruefziffer(ByVal zahl As String) As String Dim ptab(9, 9) As Integer Dim pz(9) As Integer Dim s1, s2, s3 As String Dim i1, i2 As Long s1 = "0,9,4,6,8,2,7,1,3,5" s2 = s1 For i1 = 0 To 9 For i2 = 0 To 9 ptab(i1, i2) = Mid(s2, (i2 * 2) + 1, 1) Next s3 = Microsoft.VisualBasic.Left(s1, 1) s1 = Microsoft.VisualBasic.Right(s1, Len(s1) - 2) s1 = s1 + "," + s3 s2 = s1 Next pz(0) = 0 pz(1) = 9 pz(2) = 8 pz(3) = 7 pz(4) = 6 pz(5) = 5 pz(6) = 4 pz(7) = 3 pz(8) = 2 pz(9) = 1 Dim i, x, y, z, e As Integer Dim xx As String y = 0 For i = 1 To Len(zahl) x = Val(Mid(zahl, i, 1)) y = ptab(x, y) Next Pruefziffer = Str(pz(y)) End Function #Region "Oracle" Private Function get_oracle_adresse(ByVal depotnr As String) 'Dim ole1 As OleDb.OleDbConnection 'Try ' ole1 = New OleDb.OleDbConnection(Param.OracleConnectionString) ' Dim cmd1 As New OleDb.OleDbCommand("k.S#tkb$tax_de_mail_addr.GET_MAIL_ADDR", ole1) ' Dim cmd2 As New OleDb.OleDbCommand("k.tkb$get_addr", ole1) ' cmd2.Parameters.Add("l_out", OleDb.OleDbType.VarChar, 1000) ' cmd2.Parameters(0).Direction = ParameterDirection.Output ' cmd2.CommandType = CommandType.StoredProcedure ' cmd1.Parameters.Add("i_cont_id", OleDb.OleDbType.VarChar, 1000) ' cmd1.CommandType = CommandType.StoredProcedure ' cmd1.Parameters(0).Value = deponr ' cmd1.Parameters(0).Direction = ParameterDirection.Input ' Try ' ole1.Open() ' cmd1.ExecuteScalar() ' cmd2.ExecuteScalar() ' LogEntry.Writelog(Log.Logtype.Debug, xxx) ' OracleAdresse = cmd2.Parameters(0).Value.ToString.Split(Chr(10)) ' ole1.Close() ' Return True ' Catch ex As Exception ' LogEntry.Writelog(Log.Logtype.Debug, "OLE Fehler:" + ex.Message) ' End Try 'Catch ex As Exception ' LogEntry.Writelog(Log.Logtype.Debug, ex.Message) ' LogEntry.Writelog(Log.Logtype.NOK, "Fehler beim Auslesen der Oracle-Adresse: " + ex.Message) ' ole1.Close() ' Return False 'End Try Try '****************** Dim ole1 As OleDb.OleDbConnection ole1 = New OleDb.OleDbConnection(Param.OracleConnectionString) Dim cmd1 As New OleDb.OleDbCommand("k.S#tkb$tax_de_mail_addr.GET_MAIL_ADDR", ole1) Dim cmd2 As New OleDb.OleDbCommand("k.tkb$get_addr", ole1) cmd2.Parameters.Add("l_out", OleDb.OleDbType.VarChar, 1000) cmd2.Parameters(0).Direction = ParameterDirection.Output cmd2.CommandType = CommandType.StoredProcedure cmd1.Parameters.Add("i_cont_id", OleDb.OleDbType.VarChar, 1000) cmd1.CommandType = CommandType.StoredProcedure LogEntry.Writelog(Log.Logtype.Debug, "DepotNr: " + depotnr.ToString) cmd1.Parameters(0).Value = depotnr.ToString cmd1.Parameters(0).Direction = ParameterDirection.Input ole1.Open() cmd1.ExecuteScalar() cmd2.ExecuteScalar() OracleAdresse = cmd2.Parameters(0).Value.ToString.Split(Chr(10)) LogEntry.Writelog(Log.Logtype.Debug, "Oracleadresse: " + cmd2.Parameters(0).Value.ToString) LogEntry.Writelog(Log.Logtype.Debug, "Len Oracleadresse: " + OracleAdresse.Length.ToString) ole1.Close() If OracleAdresse.Length < 2 Then LogEntry.Writelog(Log.Logtype.Debug, "Oracle-Adresse fehlt: " + OracleReturn) Return False End If Return True '****************** 'Dim ole1 As OleDb.OleDbConnection 'ole1 = New OleDb.OleDbConnection(Param.OracleConnectionString) 'Dim cmd1 As New OleDb.OleDbCommand("k.S#tkb$tax_de_mail_addr.GET_MAIL_ADDR", ole1) 'Dim cmd2 As New OleDb.OleDbCommand("k.tkb$get_addr", ole1) 'cmd2.Parameters.Add("l_out", OleDb.OleDbType.VarChar, 1000) 'cmd2.Parameters(0).Direction = ParameterDirection.Output 'cmd2.CommandType = CommandType.StoredProcedure 'cmd1.Parameters.Add("i_cont_id", OleDb.OleDbType.VarChar, 1000) 'cmd1.CommandType = CommandType.StoredProcedure 'cmd1.Parameters(0).Value = depotnr 'cmd1.Parameters(0).Direction = ParameterDirection.Input 'ole1.Open() 'cmd1.ExecuteScalar() 'cmd2.ExecuteScalar() 'OracleAdresse = cmd2.Parameters(0).Value.ToString.Split(Chr(10)) 'LogEntry.Writelog(Log.Logtype.Debug, "Oracleadresse: " + cmd2.Parameters(0).Value.ToString) 'LogEntry.Writelog(Log.Logtype.Debug, "Len Oracleadresse: " + OracleAdresse.Length.ToString) 'ole1.Close() 'If OracleAdresse.Length < 2 Then ' LogEntry.Writelog(Log.Logtype.Debug, "Oracle-Adresse fehlt: " + OracleReturn) ' Return False 'End If 'Return True Catch ex As Exception LogEntry.Writelog(Log.Logtype.NOK, "Fehler beim Auslesen der Oracle-Adresse: " + ex.Message) Return False End Try End Function #End Region Public Function check_office_2010_appl(ByVal Vorlage_DateiNr As Integer) As Integer Try Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) LogEntry.Writelog(Log.Logtype.Debug, "Timer-Intervall in Millisekunden: " + Param.TimerIntevall.ToString) scmCmdToExecute.CommandText = "Select isnull(Anwendungsnr,0) from Office2010_Vorlage_datei where Office_Vorlage_Dateinr=" + Trim(Str(Vorlage_DateiNr)) scmCmdToExecute.CommandType = CommandType.Text scmCmdToExecute.Connection = Globals.conn.scoDBConnection Try sdaAdapter.Fill(dtToReturn) If dtToReturn.Rows.Count > 0 Then Return dtToReturn.Rows(0).Item(0) Else Return 0 Catch ex As Exception LogEntry.Writelog(Log.Logtype.NOK, "Fehler check_office_2010_appl: " + ex.Message) Throw New Exception("check_office_2010_appl::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() End Try Catch ex1 As Exception LogEntry.Writelog(Log.Logtype.NOK, "Fehler check_office_2010_appl: " + ex1.Message) End Try End Function End Module