Imports System.IO Imports System.Data Imports System.Data.OleDb Imports Microsoft.Win32 Public Class Form4 Dim blnTMP As Boolean Private Sub Form4_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.Location = New Point((My.Computer.Screen.WorkingArea.Width - Me.Width) / 2, (My.Computer.Screen.WorkingArea.Height - Me.Height) / 2) txtnutzer.Text = "" txtart.Text = "" txtprogramm.Text = "" txtuser.Text = "" txtpw.Text = "" txtdatum.Text = "" txtliznr.Text = "" txtbemerkung.Text = "" ListView1.Items.Clear() ListView1.Columns.Clear() tabnr(1) = "" tabfeld(1) = 0 db_lesen5() End Sub Private Sub cmdok_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdok.Click Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=W:\visual studio 2010\Projects\Kennw\kennw\kw.mdb;") ' Dim conn As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.16.0; Data Source=W:\visual studio 2010\Projects\Kennw\kennw\kw.accdb;") 'Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=D:\visual studio 2010\Projects\kennw\kennw\kw.mdb;") 'Dim conn As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=W:\visual studio 2010\Projects\kennw\kennw\kw.mdb;") Dim sql As String = "SELECT pnutzer,part FROM Param;" Dim cmd As New OleDbCommand(sql, conn) Dim reader As OleDbDataReader Dim test As String, merker As Boolean suchen = 0 If txtnutzer.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " pnutzer like " & "'%" & txtnutzer.Text & "%'" test = " pnutzer like " & "'%" & txtnutzer.Text & "%'" suchen = 1 End If If txtart.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " part like " & "'%" & txtart.Text & "%'" test = " part like " & "'%" & txtart.Text & "%'" suchen = 1 End If If txtprogramm.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " pprog like " & "'%" & txtprogramm.Text & "%'" test = " pprog like " & "'%" & txtprogramm.Text & "%'" suchen = 1 End If If txtuser.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " puser like " & "'%" & txtuser.Text & "%'" suchen = 1 End If If txtpw.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " ppw like " & "'%" & txtpw.Text & "%'" suchen = 1 End If If txtdatum.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " datum like " & "'%" & txtdatum.Text & "%'" suchen = 1 End If If txtbemerkung.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " bemerkung like " & "'%" & txtbemerkung.Text & "%'" suchen = 1 End If If txtliznr.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " liznr like " & "'%" & txtliznr.Text & "'" suchen = 1 End If test = "" & tabfeld(TabIndex) 'For ii = 2 To TabIndex ' test = test & " and " & tabfeld(i) 'Next cmd.Connection = conn If suchen = 0 Then cmd.CommandText = "select * from param order by pnummer" Else cmd.CommandText = "select * from param where " & test & " order by pnummer" End If ind = 0 k = 0 ' ListView-Spalten erstelen ListView1.View = View.Details ListView1.FullRowSelect = True ListView1.Items.Clear() With (ListView1.Columns) .Add("Nr") .Add("Pnutzer") .Add("Art") .Add("Programm") .Add("User") .Add("Passwort") .Add("Datum") .Add("Lizenznummer") .Add("Bemerkung") End With Array.Clear(dbnummer, 0, kall + 1) Array.Clear(dbnutzer, 0, kall + 1) Array.Clear(dbart, 0, kall + 1) Array.Clear(dbprog, 0, kall + 1) Array.Clear(dbuser, 0, kall + 1) Array.Clear(dbpw, 0, kall + 1) Array.Clear(dbdatum, 0, kall + 1) Array.Clear(dbliznr, 0, kall + 1) Array.Clear(dbbemerkung, 0, kall + 1) Try conn.Open() reader = cmd.ExecuteReader() While reader.Read() ind = ind + 1 k = k + 1 If IsDBNull(reader("pnummer")) Then dbnummer(k) = 0 Else dbnummer(k) = reader("pnummer") End If If IsDBNull(reader("pnutzer")) Then dbnutzer(k) = "" Else dbnutzer(k) = reader("Pnutzer") End If If IsDBNull(reader("part")) Then dbart(k) = "" Else dbart(k) = reader("part") End If If IsDBNull(reader("Pprog")) Then dbprog(k) = "" Else dbprog(k) = reader("Pprog") End If If IsDBNull(reader("puser")) Then dbuser(k) = "" Else dbuser(k) = reader("puser") End If If IsDBNull(reader("Ppw")) Then dbpw(k) = "" Else dbpw(k) = reader("Ppw") End If If IsDBNull(reader("Datum")) Then dbdatum(k) = "" Else dbdatum(k) = reader("Datum") End If If IsDBNull(reader("LizNr")) Then dbliznr(k) = "" Else dbliznr(k) = reader("LizNr") End If If IsDBNull(reader("Bemerkung")) Then dbbemerkung(k) = "" Else dbbemerkung(k) = reader("Bemerkung") End If With ListView1.Items With .Add(dbnummer(k)) .SubItems.Add(dbnutzer(k)) .SubItems.Add(dbart(k)) .SubItems.Add(dbprog(k)) .SubItems.Add(dbuser(k)) .SubItems.Add(dbpw(k)) .SubItems.Add(dbdatum(k)) .SubItems.Add(dbliznr(k)) .SubItems.Add(dbbemerkung(k)) End With End With ListView1.Columns(0).Width = 40 ListView1.Columns(1).Width = 50 ListView1.Columns(2).Width = 100 ListView1.Columns(3).Width = 200 ListView1.Columns(4).Width = 220 ' ListView1.Columns(4).Width = 180 ListView1.Columns(5).Width = 150 ListView1.Columns(6).Width = 85 ' 500 ListView1.Columns(7).Width = 320 ListView1.Columns(8).Width = 250 ' nicht da feld(ind) = reader("pnummer") & " " & reader("pNutzer") treffer(ind) = reader("pnummer") & " " & reader("pNutzer") End While reader.Close() conn.Close() cmd.Cancel() Catch ex As Exception ' MessageBox.Show(ex.Message) End Try For i As Integer = 0 To ListView1.Items.Count - 1 If i = 0 Then ListView1.Items.Item(i).BackColor = Drawing.Color.LightBlue Else If ListView1.Items.Item(i).SubItems(1).Text.Equals( _ ListView1.Items.Item(i - 1).SubItems(1).Text) Then If merker = True Then ListView1.Items.Item(i).BackColor = _ Drawing.Color.LightBlue ListView1.Items.Item(i - 1).BackColor = _ Drawing.Color.LightBlue Else ListView1.Items.Item(i).BackColor = Drawing.Color.LightBlue ListView1.Items.Item(i - 1).BackColor = _ Drawing.Color.LightBlue End If Else If merker = False Then ListView1.Items.Item(i).BackColor = _ Drawing.Color.LightBlue merker = True Else ListView1.Items.Item(i).BackColor = Drawing.Color.LightBlue ListView1.Items.Item(i - 1).BackColor = _ Drawing.Color.LightBlue merker = False End If End If End If Next i Me.Refresh() ksel = k End Sub Private Sub cmdende_Click(sender As System.Object, e As System.EventArgs) Handles cmdende.Click Me.Close() End Sub Private Sub ListView1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListView1.SelectedIndexChanged Dim test As String, uu As String If (Me.ListView1.SelectedItems.Count > 0) Then uu = ListView1.SelectedItems.Item(0).Text lwert = ListView1.SelectedItems.Item(0).Text() End If For ii = 0 To ListView1.SelectedItems.Count - 1 test = ListView1.SelectedItems.Item(0).Text() Next db_lesen1() Me.Refresh() End Sub Private Sub db_lesen1() Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=W:\visual studio 2010\Projects\Kennw\kennw\kw.mdb;") Dim sql As String = "SELECT pnutzer,pprog FROM Param;" Dim cmd As New OleDbCommand(sql, conn) Dim reader As OleDbDataReader Dim test As String If txtprogramm.Text <> "" Then test = "pprog like '*" & txtprogramm.Text & "*'" End If If txtnutzer.Text <> "" Then test = "pnutzer like '" & txtnutzer.Text & "'" End If If txtart.Text <> "" Then test = "part like '" & txtnutzer.Text & ",pnutzer like '" & txtart.Text & "'" End If cmd.Connection = conn cmd.CommandText = "select * from param where pnummer=" & lwert & " order by pnummer;" ind = 0 k = 0 Try conn.Open() reader = cmd.ExecuteReader() While reader.Read() ind = ind + 1 k = k + 1 If IsDBNull(reader("pnummer")) Then dbnummer(k) = "" Else dbnummer(k) = reader("pnummer") End If If IsDBNull(reader("pnutzer")) Then txtnutzer.Text = "" Else txtnutzer.Text = reader("pnutzer") End If If IsDBNull(reader("Part")) Then txtart.Text = "" Else txtart.Text = reader("Part") End If If IsDBNull(reader("PProg")) Then txtprogramm.Text = "" Else txtprogramm.Text = reader("PProg") End If If IsDBNull(reader("Puser")) Then txtuser.Text = "" Else txtuser.Text = reader("Puser") End If If IsDBNull(reader("PPw")) Then txtpw.Text = "" Else txtpw.Text = reader("PPw") End If If IsDBNull(reader("Datum")) Then txtdatum.Text = "" Else txtdatum.Text = reader("Datum") End If If IsDBNull(reader("Liznr")) Then txtliznr.Text = "" Else txtliznr.Text = reader("Liznr") End If If IsDBNull(reader("Bemerkung")) Then txtbemerkung.Text = "" Else txtbemerkung.Text = reader("Bemerkung") End If End While reader.Close() conn.Close() cmd.Cancel() Catch ex As Exception ' MessageBox.Show(ex.Message) End Try kall = k End Sub Private Sub db_lesen5() ' Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=W:\visual studio 2010\Projects\kennw\kennw\kw.mdb;") Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=W:\visual studio 2010\Projects\Kennw\kennw\kw.mdb;") Dim sql As String = "SELECT pnutzer,pprog FROM Param;" Dim cmd As New OleDbCommand(sql, conn) Dim reader As OleDbDataReader cmd.Connection = conn cmd.CommandText = "select * from Tabelle1" Try conn.Open() reader = cmd.ExecuteReader() While reader.Read() If IsDBNull(reader("fnummer")) Then tabnr(1) = "" Else tabnr(1) = reader("fnummer") End If Exit While End While reader.Close() conn.Close() cmd.Cancel() Catch ex As Exception ' MessageBox.Show(ex.Message) End Try kall = k End Sub Private Sub db_lesen9() Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=W:\visual studio 2010\Projects\Kennw\kennw\kw.mdb;") Dim sql As String = "SELECT pnutzer,pprog FROM Param;" Dim cmd As New OleDbCommand(sql, conn) Dim reader As OleDbDataReader cmd.Connection = conn cmd.CommandText = "select * from param order by pnummer;" ind = 0 k = 0 Try conn.Open() reader = cmd.ExecuteReader() While reader.Read() ind = ind + 1 k = k + 1 If IsDBNull(reader("pnummer")) Then dbnummer(k) = "" Else dbnummer(k) = reader("pnummer") End If If IsDBNull(reader("PNutzer")) Then dbnutzer(k) = "" Else dbnutzer(k) = reader("PNutzer") End If If IsDBNull(reader("PArt")) Then dbart(k) = "" Else dbart(k) = reader("PArt") End If If IsDBNull(reader("PProg")) Then dbprog(k) = "" Else dbprog(k) = reader("PProg") End If If IsDBNull(reader("datum")) Then dbdatum(k) = "" Else dbdatum(k) = reader("datum") End If If IsDBNull(reader("PUser")) Then dbuser(k) = "" Else dbuser(k) = reader("PUser") End If If IsDBNull(reader("PPw")) Then dbpw(k) = "" Else dbpw(k) = reader("PPw") End If If IsDBNull(reader("LizNr")) Then dbliznr(k) = "" Else dbliznr(k) = reader("LizNr") End If If IsDBNull(reader("Bemerkung")) Then dbbemerkung(k) = "" Else dbbemerkung(k) = reader("Bemerkung") End If End While kall = k reader.Close() conn.Close() cmd.Cancel() Catch ex As Exception End Try kall = k End Sub Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click Dim word As Object, strfehlertext As String, i As Integer, zz As Byte If txtnutzer.Text <> " " Then 'db_lesen9() End If On Error Resume Next word = GetObject(, "Word.application") If Err.Number <> 0 Then Err.Clear() word = CreateObject("Word.application") If Err.Number <> 0 Then strfehlertext = CStr(Err.Number) & " - " & Err.Description End If End If 'Select Case ksel ' Case Is > 76 : doc = word.Documents.Open("E:\visual studio 2010\Projects\kennw\kennw\leer2.dotx") ' Case Is < 77 : If ksel < 47 Then ' doc = word.Documents.Open("E:\visual studio 2010\Projects\kennw\kennw\leer0.docx") ' Else ' doc = word.Documents.Open("E:\visual studio 2010\Projects\kennw\kennw\leer1.dotx") ' End If ' Case Is < 47 : doc = word.Documents.Open("E:\visual studio 2010\Projects\kennw\kennw\leer0.dotx") 'End Select doc = word.Documents.Open("W:\visual studio 2010\Projects\kennw\kennw\leer.docx") If Err.Number <> 0 Then strfehlertext = CStr(Err.Number) & " - " & Err.Description End If word.selection.Font.Name = "Times New Roman" word.selection.Font.Size = 11 word.selection.PageSetup.BottomMargin = 9.07 word.Application.Visible = True word.selection.Font.Size = 8 word.selection.Font.Bold = False word.selection.ParagraphFormat.Alignment = 0 word.selection.Font.Name = "Lucida Console" 'With word.selection.tables(1) ' If .Style <> "Tabellengitternetz" Then ' .Style = "Tabellengitternetz" ' End If ' .ApplyStyleHeadingRows = True ' .ApplyStyleLastRow = False ' .ApplyStyleFirstColumn = True ' .ApplyStyleLastColumn = False ' .ApplyStyleRowBands = True ' .ApplyStyleColumnBands = False 'End With 'word.selection.moveright() For i = 1 To ksel If zz >= 90 Then word.selection.InsertBreak() 'word.Selection.InsertBreak(1) zz = 0 End If word.selection.Font.Bold = True word.selection.typetext("Nummer: " & dbnummer(i).ToString) word.selection.typeparagraph() word.selection.typetext("Nutzer: " & dbnutzer(i)) word.selection.typeparagraph() word.selection.typetext("Art: " & Mid(dbart(i), 1, 8)) word.selection.typeparagraph() word.selection.typetext("Programm: " & dbprog(i)) word.selection.typeparagraph() word.selection.typetext("Benutzer: " & dbuser(i)) word.selection.typeparagraph() word.selection.typetext("Passwort: " & dbpw(i)) word.selection.typeparagraph() word.selection.typetext("Datum: " & dbdatum(i)) word.selection.typeparagraph() word.selection.typetext("LizNr: " & dbliznr(i)) word.selection.typeparagraph() word.selection.typetext("Bemerkung: " & dbbemerkung(i)) word.selection.typeparagraph() word.selection.typeparagraph() zz = zz + 10 Next 'For i = 1 To ksel ' 'word.selection.Font.Size = 8 ' word.selection.typetext(dbnummer(i).ToString) ' word.selection.moveright() ' word.selection.typetext(dbnutzer(i)) ' word.selection.moveright() ' word.selection.typetext(Mid(dbart(i), 1, 8)) ' word.selection.moveright() ' word.selection.typetext(dbprog(i)) ' word.selection.moveright() ' word.selection.typetext(dbuser(i)) ' word.selection.moveright() ' word.selection.typetext(dbpw(i)) ' word.selection.moveright() ' word.selection.typetext(dbdatum(i)) ' word.selection.moveright() ' word.selection.typetext(dbliznr(i)) ' word.selection.moveright() ' word.selection.typetext(dbbemerkung(i)) ' word.selection.moveright() 'Next End Sub Private Sub loefelder() txtart.Text = "" txtprogramm.Text = "" txtuser.Text = "" txtpw.Text = "" txtdatum.Text = "" txtliznr.Text = "" txtbemerkung.Text = "" TabIndex = 0 For ii = 1 To 20 tabfeld(i) = "" Next ListView1.Clear() End Sub Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=W:\visual studio 2010\Projects\Kennw\kennw\kw.mdb;") Dim cmdUpdate As New OleDbCommand Dim sql As String = "SELECT count(*) FROM Param where verfahren=;" Dim test As String, str As String, testnr As Integer, speichern As String, test1 As String, wert As String, wert1 As String str = "" Dim cmd As New OleDbCommand(str, conn) speichern = "" wert1 = "" txtdatum.Text = DateTime.Now.ToShortDateString db_lesen5() If txtnutzer.Text <> "" Then test = "pnutzer like '" & txtnutzer.Text & "'" test1 = "INSERT INTO param(PNummer,pnutzer" Else Label1.Text = "kein Verfahren angegeben!" Exit Sub End If If txtart.Text <> "" Then test = "pnutzer like '" & txtnutzer.Text & ",part like '" & txtart.Text & "'" test1 = test1 & ",part" Else Label1.Text = "kein Nutzer angegeben!" Exit Sub End If If txtprogramm.Text <> "" Then test = "pprog like '*" & txtprogramm.Text & "*'" test1 = test1 & ",pprog" If tabnr(1) <> "" Then wert = Val(tabnr(1)) & ",'" & txtnutzer.Text & "','" & txtart.Text & "','" & txtprogramm.Text wert = txtnutzer.Text & "','" & txtart.Text & "','" & txtprogramm.Text Else testnr = kall wert = testnr + 1 & ",'" & txtnutzer.Text & "','" & txtart.Text & "','" & txtprogramm.Text wert = txtnutzer.Text & "','" & txtart.Text & "','" & txtprogramm.Text End If Else Label1.Text = "kein Kennwort angegeben!" Exit Sub End If If txtuser.Text <> "" Then test = "puser like '*" & txtuser.Text & "*'" test1 = test1 & ",puser" wert = wert & "','" & txtuser.Text End If If txtpw.Text <> "" Then test = "ppw like '*" & txtpw.Text & "*'" test1 = test1 & ",ppw" wert = wert & "','" & txtpw.Text End If If txtdatum.Text <> "" Then test = "datum like '*" & txtdatum.Text & "*'" test1 = test1 & ",datum" wert = wert & "','" & txtdatum.Text End If If txtliznr.Text <> "" Then test = "liznr like '*" & txtliznr.Text & "*'" test1 = test1 & ",liznr" wert = wert & "','" & txtliznr.Text End If If txtbemerkung.Text <> "" Then test = "bemerkung like '*" & txtbemerkung.Text & "*'" test1 = test1 & ",bemerkung" wert = wert & "','" & txtbemerkung.Text End If testnr = CInt(lwert) test1 = test1 & ") Values (" wert = wert & "')" ' str = "select count(*) from tabelle1" str = "select * from param where pprog=" & "'" & txtprogramm.Text & "'" conn.Open() Try cmd = New OleDbCommand(str, conn) test = cmd.ExecuteScalar() If cmd.ExecuteScalar = 0 Then speichern = "Satz einfügen" db_lesen9() wert1 = kall + 1 & ",'" & wert Else speichern = "Satz vorhanden!" kall = cmd.ExecuteScalar End If cmd.Dispose() conn.Close() Catch ex As Exception MsgBox(ex.Message) End Try ' If lwert <> "0" Then If testnr <> 0 Then MessageBox.Show("Nummer:" & vbTab & vbTab & kall & vbNewLine & "Nutzer: " & vbTab & vbTab & txtnutzer.Text & vbNewLine & "Art: " & vbTab & vbTab & txtart.Text & vbNewLine & "Programm: " & vbTab & txtprogramm.Text & vbNewLine & "Benutzer: " & vbTab & vbTab & txtuser.Text & vbNewLine & "Passwort: " & vbTab & vbTab & txtpw.Text & vbNewLine & "Datum: " & vbTab & vbTab & txtdatum.Text & vbNewLine & "LizNr: " & vbTab & vbTab & txtliznr.Text & vbNewLine & "Bemerkung: " & vbTab & txtbemerkung.Text, "Datensatz aktualisieren? ", MessageBoxButtons.YesNo) If MsgBoxResult.Yes Then str = "update param set pnutzer = '" & txtnutzer.Text & "', part = '" & txtart.Text & "', PProg = '" & txtprogramm.Text & "', Puser = '" & txtuser.Text & "', ppw = '" & txtpw.Text & "', datum = '" & txtdatum.Text & "', liznr = '" & txtliznr.Text & "', bemerkung = '" & txtbemerkung.Text & "' Where PNummer = " & testnr '" conn.Open() Try cmd = New OleDbCommand(str, conn) cmd.ExecuteNonQuery() Catch ex As Exception MsgBox(ex.Message) End Try End If conn.Close() Else MessageBox.Show("Nummer:" & vbTab & vbTab & kall + 1 & vbNewLine & "Nutzer: " & vbTab & vbTab & txtnutzer.Text & vbNewLine & "Art: " & vbTab & vbTab & txtart.Text & vbNewLine & "Programm: " & vbTab & txtprogramm.Text & vbNewLine & "Benutzer: " & vbTab & vbTab & txtuser.Text & vbNewLine & "Passwort: " & vbTab & vbTab & txtpw.Text & vbNewLine & "Datum: " & vbTab & vbTab & DateTime.Now.ToShortDateString & vbNewLine & "LizNr: " & vbTab & vbTab & txtliznr.Text & vbNewLine & "Bemerkung: " & vbTab & txtbemerkung.Text, "Datensatz hinzufügen? ", MessageBoxButtons.YesNo) str = "SELECT MAX(PNummer) FROM param" conn.Open() Try cmd = New OleDbCommand(str, conn) test = cmd.ExecuteScalar() Catch ex As Exception MsgBox(ex.Message) End Try conn.Close() If speichern = "Satz einfügen" Then wert = wert1 End If testnr = CInt(test) txtdatum.Text = DateTime.Now.ToShortDateString If MsgBoxResult.Yes Then str = test1 & wert conn.Open() Try cmd = New OleDbCommand(str, conn) cmd.ExecuteNonQuery() Catch ex As Exception MsgBox(ex.Message) End Try conn.Close() End If End If ' Tabelle neu einlesen 'zverfahren = txtnutzer.Text 'znutzer = txtart.Text 'zkennwort = txtprogramm.Text 'zbetreuer = txtuser.Text 'ztelefon = txtpw.Text 'zbemerkung = txtliznr1.Text loefelder() txtnutzer.Text = "" txtart.Text = "" txtprogramm.Text = "" txtuser.Text = "" txtpw.Text = "" txtbemerkung.Text = "" lwert = 0 cmdok_Click(Nothing, Nothing) End Sub Private Sub cmdloe_Click(sender As System.Object, e As System.EventArgs) Handles cmdloe.Click Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=W:\visual studio 2010\Projects\Kennw\kennw\kw.mdb;") Dim cmdUpdate As New OleDbCommand Dim sql As String = "SELECT count(*) FROM Param where verfahren=;" Dim str As String, testnr As Integer str = "" Dim cmd As New OleDbCommand(str, conn) testnr = CInt(lwert) str = "Delete from param Where pnummer = " & testnr & "" conn.Open() Try cmd = New OleDbCommand(str, conn) cmd.ExecuteNonQuery() Catch ex As Exception MsgBox(ex.Message) End Try conn.Close() str = "INSERT INTO Tabelle1(fnummer) VALUES(" & testnr & ")" conn.Open() Try cmd = New OleDbCommand(str, conn) cmd.ExecuteNonQuery() Catch ex As Exception MsgBox(ex.Message) End Try conn.Close() ' Hier neu einlesen!!!!!!!!!!!!!! loefelder() db_lesen5() ' Nächste Nummer holen txtnutzer.Text = "" cmdok_Click(Nothing, Nothing) ' db_lesen1() ' Neu einlesen!!!!!!!!!!!!!!!! End Sub Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button6.Click txtnutzer.Text = "" txtart.Text = "" txtprogramm.Text = "" txtuser.Text = "" txtpw.Text = "" txtdatum.Text = "" txtliznr.Text = "" txtbemerkung.Text = "" TextBox1.Clear() Me.Update() End Sub Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button7.Click ' Variable um bei schon geöffnetem Outlook dieses nicht zu schliessen ' Dim blnTMP As Boolean '-------------------------------------------------------------------------- ' Module : Module1 ' Procedure : Main ' Author : Case (Ralf Stolzenburg) ' Date : 09.04.2014 ' Purpose : Outlook Subject mehrere gleiche neueste Infos ausgeben... '-------------------------------------------------------------------------- ' Variablendeklaration ListView2.View = View.Details ListView2.FullRowSelect = True ListView2.Items.Clear() With (ListView2.Columns) .Add("Nr") .Add("Von") .Add("Betr.") .Add("Datum") End With ListView2.Columns(0).Width = 50 ListView2.Columns(1).Width = 250 ListView2.Columns(2).Width = 200 ListView2.Columns(3).Width = 150 Dim objNameSpace As Object Dim objFolder As Object Dim objItem As Object Dim manz As Byte Dim strTMP, mtext, mvon, mname, mzeit As String Dim objApp As Object Dim datTime As Date ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke On Error GoTo Fin ' Objektvariable mit Outlookapplikation belegen objApp = OffApp("Outlook") ' Wenn die Applikation vorhanden ist... If Not objApp Is Nothing Then ' Eine Outlook-Sitzung anlegen ' GetNamespace("MAPI") und Session sind austauschbar objNameSpace = objApp.Session 'GetNamespace("MAPI") ' Konstante für Posteingang Const olFolderInbox = 6 ' Objektvariable mit Posteingang belegen objFolder = objNameSpace.GetDefaultFolder(olFolderInbox) ' Wenn Mails im Posteingang sind, dann... If objFolder.Items.Count > 0 Then ' Temporäre Zeit vorgeben datTime = "01.01.1900 00:00:00" ' Jede Mail im Ordner Posteingang durchgehen For Each objItem In objFolder.Items With objItem ' Wenn der Betreff mit "Test" beginnt und ' irgendwie weitergeht, dann... If .Subject Like "*" Then ' Wenn die Empfangszeit > der ' temporären Zeit ist, dann... If .ReceivedTime > datTime Then manz = manz + 1 ' Setze die temporäre Zeit neu datTime = .ReceivedTime ' Hole Informationen in Stringvariable ' Hier Mailadresse und Name des Senders ' dann noch die Empfangszeit strTMP = .SenderEmailAddress & " / " & .SenderName & " / " & .ReceivedTime & " / " & .Body mvon = .senderemailaddress mname = .sendername mzeit = .receivedtime mtext = .SenderEmailAddress & " / " & .SenderName & " / " & .ReceivedTime 'ListView2.Items.Add(mtext) With ListView2.Items With .Add(manz) .SubItems.Add(mvon) .SubItems.Add(mname) .SubItems.Add(mzeit) End With End With End If End If End With ' Nächste Mail Next objItem ' Wenn die temporäre Zeit unterschiedlich ist, dann... If datTime <> "01.01.1900 00:00:00" Then ' ' Gib die gesammelten Informationen aus ' MsgBox(strTMP) End If Else ' Es sind keine Mails im Posteingang MsgBox("There are " & objFolder.Items.Count & " message(s) in your inbox.") End If Else ' Kein Outlook installiert MsgBox("Application not installed!") End If Fin: ' Wenn die Applikation nicht offen war, schliesse sie If Not objApp Is Nothing Then If blnTMP = True Then objApp.Quit() blnTMP = False End If End If ' Setze die Objektvariablen auf Nothing objFolder = Nothing objNameSpace = Nothing objApp = Nothing ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung If Err.Number <> 0 Then MsgBox("Error: " & _ Err.Number & " " & Err.Description) End Sub Private Function OffApp(ByVal strApp As String, _ Optional blnVisible As Boolean = True) As Object Dim objApp As Object On Error Resume Next objApp = GetObject(, strApp & ".Application") Select Case Err.Number Case 429 Err.Clear() objApp = CreateObject(strApp & ".Application") blnTMP = True If blnVisible = True Then On Error Resume Next objApp.Visible = True Err.Clear() End If End Select On Error GoTo 0 OffApp = objApp objApp = Nothing End Function Sub MailVersenden() Dim outl, Mail As Object outl = CreateObject("Outlook.Application") Mail = outl.CreateItem(0) Mail.Subject = "Bestellung " '& VBA.Date Mail.To = "lutz.rickenstorf@superkabel.de" 'Mail.CC = "admin@company.info; purch@company.info, boss@company.info" 'Mail.BCC = "secret@company.info" 'Wichtigkeit Hoch (1 = normal, 0 = niedrig) Mail.Importance = 2 'Standardtext 'Mail.body = "Hallo Kollegen!" & vbCrLf & vbCrLf & _ '"Anbei unser Auftrag." & vbCrLf & vbCrLf & _ '"Mit freundlichen Grüssen" & vbCrLf & vbCrLf & _ '"Euer Sales-Team" & vbCrLf & vbCrLf RichTextBox1.LoadFile("w:\Videothek\VBtext\L0.txt", RichTextBoxStreamType.PlainText) Mail.body = RichTextBox1.Text 'Eine Datei auf Laufwerk E:\ als Anhang mitsenden... Mail.Attachments.Add("w:\Videothek\VBtext\L1181.txt") 'oder: die aktive Exceldatei als Anhang mitsenden... 'Mail.Attachments.Add(ThisWorkbook.FullName) 'Mail anzeigen Mail.Display() 'Ein sofortiger Mail-Versand geht in Firmen wegen Sicherheitseinstellungen oft nicht: 'Mail.Send 'aber es gibt eine Lösung mit SendKeys per Windows Scripting Host (Verweis ins VB-Projekt einfügen!): Dim WshShell WshShell = CreateObject("WScript.Shell") WshShell.AppActivate(Mail) 'Sendet ein "Alt-S", Outlook sendet Mail sofort ohne Sicherheitsabfrage: WshShell.SendKeys("%s") Mail = Nothing outl = Nothing WshShell = Nothing End Sub Private Sub Button5_Click(sender As System.Object, e As System.EventArgs) Handles Button8.Click MailVersenden() End Sub Private Sub option1_click(sender As System.Object, e As System.EventArgs) Handles option1.Click otest = "computer" optlesen("computer") End Sub Private Sub option2_click(sender As System.Object, e As System.EventArgs) Handles option2.Click otest = "handy" optlesen("handy") End Sub Private Sub optlesen(otest) Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=W:\visual studio 2010\Projects\Kennw\kennw\kw.mdb;") 'Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=D:\visual studio 2010\Projects\kennw\kennw\kw.mdb;") 'Dim conn As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=W:\visual studio 2010\Projects\kennw\kennw\kw.mdb;") Dim sql As String = "SELECT pnutzer,part FROM Param;" Dim cmd As New OleDbCommand(sql, conn) Dim reader As OleDbDataReader Dim test As String, merker As Boolean TabIndex = 0 suchen = 0 If txtnutzer.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " pnutzer like " & "'%" & txtnutzer.Text & "%'" test = " pnutzer like " & "'%" & txtnutzer.Text & "%'" suchen = 1 End If If txtart.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " part like " & "'%" & txtart.Text & "%'" test = " part like " & "'%" & txtart.Text & "%'" suchen = 1 End If If txtprogramm.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " pprog like " & "'%" & txtprogramm.Text & "%'" suchen = 1 End If If txtuser.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " puser like " & "'%" & txtuser.Text & "%'" suchen = 1 End If If txtpw.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " ppw like " & "'%" & txtpw.Text & "%'" suchen = 1 End If If txtdatum.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " datum like " & "'%" & txtdatum.Text & "%'" suchen = 1 End If If txtbemerkung.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " bemerkung like " & "'%" & txtbemerkung.Text & "%'" suchen = 1 End If If txtliznr.Text <> "" Then TabIndex = TabIndex + 1 tabfeld(TabIndex) = " liznr like " & "'%" & txtliznr.Text & "'" suchen = 1 End If test = " " & tabfeld(1) For ii = 2 To TabIndex test = test & " and " & tabfeld(i) Next cmd.Connection = conn If suchen = 0 Then cmd.CommandText = "select * from param where part=" & Chr(34) & otest & Chr(34) & " order by pnummer" Else ' cmd.CommandText = "select * from param where " & test & " order by pnummer" cmd.CommandText = "select * from param where part=" & Chr(34) & otest & Chr(34) & " and " & test & " order by pnummer" End If ind = 0 k = 0 ' ListView-Spalten erstelen ListView1.View = View.Details ListView1.FullRowSelect = True ListView1.Items.Clear() With (ListView1.Columns) .Add("Nr") .Add("Pnutzer") .Add("Art") .Add("Programm") .Add("User") .Add("Passwort") .Add("Datum") .Add("Lizenznummer") .Add("Bemerkung") End With Array.Clear(dbnummer, 0, kall + 1) Array.Clear(dbnutzer, 0, kall + 1) Array.Clear(dbart, 0, kall + 1) Array.Clear(dbprog, 0, kall + 1) Array.Clear(dbuser, 0, kall + 1) Array.Clear(dbpw, 0, kall + 1) Array.Clear(dbdatum, 0, kall + 1) Array.Clear(dbliznr, 0, kall + 1) Array.Clear(dbbemerkung, 0, kall + 1) Try conn.Open() reader = cmd.ExecuteReader() While reader.Read() ind = ind + 1 k = k + 1 If IsDBNull(reader("pnummer")) Then dbnummer(k) = "" Else dbnummer(k) = reader("pnummer") End If If IsDBNull(reader("pnutzer")) Then dbnutzer(k) = "" Else dbnutzer(k) = reader("Pnutzer") End If If IsDBNull(reader("part")) Then dbart(k) = "" Else dbart(k) = reader("part") End If If IsDBNull(reader("Pprog")) Then dbprog(k) = "" Else dbprog(k) = reader("Pprog") End If If IsDBNull(reader("puser")) Then dbuser(k) = "" Else dbuser(k) = reader("puser") End If If IsDBNull(reader("Ppw")) Then dbpw(k) = "" Else dbpw(k) = reader("Ppw") End If If IsDBNull(reader("Datum")) Then dbdatum(k) = "" Else dbdatum(k) = reader("Datum") End If If IsDBNull(reader("LizNr")) Then dbliznr(k) = "" Else dbliznr(k) = reader("LizNr") End If If IsDBNull(reader("Bemerkung")) Then dbbemerkung(k) = "" Else dbbemerkung(k) = reader("Bemerkung") End If With ListView1.Items With .Add(dbnummer(k)) .SubItems.Add(dbnutzer(k)) .SubItems.Add(dbart(k)) .SubItems.Add(dbprog(k)) .SubItems.Add(dbuser(k)) .SubItems.Add(dbpw(k)) .SubItems.Add(dbdatum(k)) .SubItems.Add(dbliznr(k)) .SubItems.Add(dbbemerkung(k)) End With End With ListView1.Columns(0).Width = 30 ListView1.Columns(1).Width = 50 ListView1.Columns(2).Width = 70 ListView1.Columns(3).Width = 200 ListView1.Columns(4).Width = 180 ListView1.Columns(5).Width = 150 ListView1.Columns(6).Width = 70 ' 500 ListView1.Columns(7).Width = 350 ListView1.Columns(8).Width = 150 ' nicht da feld(ind) = reader("pnummer") & " " & reader("pNutzer") treffer(ind) = reader("pnummer") & " " & reader("pNutzer") End While reader.Close() conn.Close() cmd.Cancel() Catch ex As Exception ' MessageBox.Show(ex.Message) End Try For i As Integer = 0 To ListView1.Items.Count - 1 If i = 0 Then ListView1.Items.Item(i).BackColor = Drawing.Color.LightBlue Else If ListView1.Items.Item(i).SubItems(1).Text.Equals( _ ListView1.Items.Item(i - 1).SubItems(1).Text) Then If merker = True Then ListView1.Items.Item(i).BackColor = _ Drawing.Color.LightBlue ListView1.Items.Item(i - 1).BackColor = _ Drawing.Color.LightBlue Else ListView1.Items.Item(i).BackColor = Drawing.Color.LightBlue ListView1.Items.Item(i - 1).BackColor = _ Drawing.Color.LightBlue End If Else If merker = False Then ListView1.Items.Item(i).BackColor = _ Drawing.Color.LightBlue merker = True Else ListView1.Items.Item(i).BackColor = Drawing.Color.LightBlue ListView1.Items.Item(i - 1).BackColor = _ Drawing.Color.LightBlue merker = False End If End If End If Next i Me.Refresh() ksel = k End Sub Private Sub Listview2_Click(sender As Object, e As System.EventArgs) Handles ListView2.Click Dim smvon As Integer For Each SelItem As ListViewItem In ListView2.SelectedItems smvon = SelItem.Text Next Dim objNameSpace As Object Dim objFolder As Object Dim objItem As Object Dim manz As Byte Dim strTMP, mtext, mvon, mname, mzeit As String Dim objApp As Object Dim datTime As Date ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke On Error GoTo Fin ' Objektvariable mit Outlookapplikation belegen objApp = OffApp("Outlook") ' Wenn die Applikation vorhanden ist... RichTextBox1.Text = "" If Not objApp Is Nothing Then ' Eine Outlook-Sitzung anlegen ' GetNamespace("MAPI") und Session sind austauschbar objNameSpace = objApp.Session 'GetNamespace("MAPI") ' Konstante für Posteingang Const olFolderInbox = 6 ' Objektvariable mit Posteingang belegen objFolder = objNameSpace.GetDefaultFolder(olFolderInbox) ' Wenn Mails im Posteingang sind, dann... If objFolder.Items.Count > 0 Then ' Temporäre Zeit vorgeben datTime = "01.01.1900 00:00:00" ' Jede Mail im Ordner Posteingang durchgehen For Each objItem In objFolder.Items With objItem ' Wenn der Betreff mit "Test" beginnt und ' irgendwie weitergeht, dann... If .Subject Like "*" Then ' Wenn die Empfangszeit > der ' temporären Zeit ist, dann... If .ReceivedTime > datTime Then manz = manz + 1 ' Setze die temporäre Zeit neu datTime = .ReceivedTime ' Hole Informationen in Stringvariable ' Hier Mailadresse und Name des Senders ' dann noch die Empfangszeit strTMP = .SenderEmailAddress & " / " & .SenderName & " / " & .ReceivedTime & " / " & .Body If manz = smvon Then RichTextBox1.Text = .body End If mvon = .senderemailaddress mname = .sendername mzeit = .receivedtime mtext = .SenderEmailAddress & " / " & .SenderName & " / " & .ReceivedTime 'ListView2.Items.Add(mtext) With ListView2.Items With .Add(manz) .SubItems.Add(mvon) .SubItems.Add(mname) .SubItems.Add(mzeit) End With End With End If End If End With ' Nächste Mail Next objItem ' Wenn die temporäre Zeit unterschiedlich ist, dann... If datTime <> "01.01.1900 00:00:00" Then ' ' Gib die gesammelten Informationen aus ' MsgBox(strTMP) End If Else ' Es sind keine Mails im Posteingang MsgBox("There are " & objFolder.Items.Count & " message(s) in your inbox.") End If Else ' Kein Outlook installiert MsgBox("Application not installed!") End If Fin: ' Wenn die Applikation nicht offen war, schliesse sie If Not objApp Is Nothing Then If blnTMP = True Then objApp.Quit() blnTMP = False End If End If ' Setze die Objektvariablen auf Nothing objFolder = Nothing objNameSpace = Nothing objApp = Nothing ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung If Err.Number <> 0 Then MsgBox("Error: " & _ Err.Number & " " & Err.Description) End Sub End Class