Imports Microsoft.Office.Interop Imports System.Data.SqlClient Imports System.Data.SqlTypes Imports System.IO Public Class clsexcel Dim objexcel As Excel.Application 'Seit Office 2003 Dim docexcel As Excel.Workbook Dim sheetexcel As Excel.Worksheet Dim Excelfile As String = "" Dim shXL As Excel.Worksheet Dim ds As New DataSet Public exceldata As New DataTable Public dokumenttypnr As Integer Public Sub New() Try Dim csv As New MyNameSpace.CSVDataAdapter(Globals.ApplicationPath + "\Exceldata.csv", True, ";") csv.Fill(ds) 'Rel 4.03 3: Wenn die erste Spalte <> "Parternr" dann Meldung ausgeben und alle Rows löchen exceldata = ds.Tables(0).Copy Catch End Try End Sub Public Function Check_Excel(ByVal dokumentid As String) As Boolean Try Dim d As New edokadb.clsDokument d.cpMainConnectionProvider = Globals.conn_edoka d.sDokumentid = New SqlString(CType(dokumentid, String)) d.SelectOne() For Each r As DataRow In exceldata.Rows If r("dokumenttypnr") = d.iDokumenttypnr.Value Then dokumenttypnr = d.iDokumenttypnr.Value Return True Exit Function End If Next Return False Catch ex As Exception Return False End Try End Function Public Function Get_Excel(ByVal dokumentid As String) As Boolean Try Dim dm As New DocMgmt Dim doc As New DocMgmt Dim tdoctype As New DataTable Dim doctype As String Dim dokumenttypnr As Integer Dim dateiformat As String 'BUD - 2006.10.04 Dim istFarbigArchivieren As Boolean = False Dim d As New edokadb.clsDokument d.cpMainConnectionProvider = conn_edoka d.sDokumentid = New SqlString(CType(dokumentid, String)) d.SelectOne() dokumenttypnr = d.iDokumenttypnr.Value doctype = GetDocType(d.sDokumentname.Value) dateiformat = doctype d.Dispose() Select Case UCase(doctype) Case "XLS", "XLSX", "XLSM", "XLT", "XLTX", "XLTM" Excelfile = Params.ExcelPath + dokumentid + "." + doctype End Select If File.Exists(excelfile) Then File.Delete(excelfile) End If If doc.Get_From_DB(dokumentid, excelfile) = False Then Return True End If Catch Return False End Try End Function Public Function Get_Excel_Values(ByVal dokumentid As String) Try ' dokumenttypnr = 2421 ' Excelfile = "k:\edoka\OFFEDK0002019000455228.xlsm" Get_Excel(dokumentid) objexcel = New Excel.Application sheetexcel = New Excel.Worksheet objexcel.Workbooks.Open(Excelfile) For Each r As DataRow In exceldata.Rows If r("dokumenttypnr") = dokumenttypnr Then Try Dim wert As String Dim sheetno As Integer Dim rowno As Integer Dim colno As Integer rowno = r("rowindex") colno = r("columnindex") sheetno = r("sheet") wert = objexcel.ActiveWorkbook.Sheets(sheetno).Cells(rowno, colno).value().ToString Dokumentwert_Sichern(r("Bezeichnung") + ";" + wert, r("valuenr"), dokumentid) Catch ex As Exception MsgBox(ex.Message) End Try End If Next Catch Finally sheetexcel = Nothing objexcel.ActiveWorkbook.Close(False) objexcel.Quit() objexcel = Nothing End Try End Function Public Sub Dokumentwert_Sichern(ByVal wert As String, ByVal feldnr As Integer, ByVal dokumentid As String) Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim conn As New SqlConnection(Globals.sConnectionString_edoka) scmCmdToExecute.CommandText = "dbo.SP_Dokument_Information_Wert" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = conn scmCmdToExecute.Connection.Open() Try scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid)) scmCmdToExecute.Parameters.Add(New SqlParameter("@vorlagenfeldnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, feldnr)) scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, wert)) scmCmdToExecute.ExecuteNonQuery() Catch ex As Exception ' // some error occured. Bubble it to caller and encapsulate Exception object Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) Finally scmCmdToExecute.Connection.Close() scmCmdToExecute.Dispose() conn.Dispose() End Try End Sub End Class