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.

1481 lines
62 KiB

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("<w:t>Nr.") > 0 Then
'Kundennr = s.Substring(s.IndexOf("DepotNr") + 8, 15)
Kundennr = s.Substring(s.IndexOf("<w:t>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