' Code Form2 ================================================

Imports System.IO
Imports System.Data
Imports System.Data.OleDb
Imports Word = Microsoft.Office.Interop.Word
Public Class Form2
    Private Sub cmdende_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdende.Click
        End
    End Sub

    Private Sub cmdsuch_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdsuch.Click
        Form4.ShowDialog()
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Form5.ShowDialog()
    End Sub
    Private Sub cmddruck_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
        Dim word As Object, seitel As Integer, strFehlerText As String
        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 kall
            Case Is > 76 : doc = word.Documents.Open("W:\visual studio 2010\Projects\kennw\kennw\leer2.dotx")
            Case Is < 77 : doc = word.Documents.Open("W:\visual studio 2010\Projects\kennw\kennw\leer1.dotx")
            Case Is < 39 : doc = word.Documents.Open("W:\visual studio 2010\Projects\kennw\kennw\leer0.dotx")
        End Select
        If Err.Number <> 0 Then
            strFehlerText = CStr(Err.Number) & " - " & Err.Description
        End If
        db_lesen()
        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"
        word.selection.Font.Size = 12
        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.Font.Size = 8
        word.selection.Font.Bold = True
        word.selection.Font.Name = "Lucida Console"
        'word.selection.moveright()
        For m = 1 To kall
            word.selection.typetext(dbnummer(m).ToString)
            word.selection.moveright()
            word.selection.typetext(dbnutzer(m))
            word.selection.moveright()
            word.selection.typetext(dbart(m))
            word.selection.moveright()
            word.selection.typetext(dbprog(m))
            word.selection.moveright()
            word.selection.typetext(dbuser(m))
            word.selection.moveright()
            word.selection.typetext(dbpw(m))
            word.selection.moveright()
            word.selection.typetext(dbdatum(m))
            word.selection.moveright()
            word.selection.typetext(dbliznr(m))
            word.selection.moveright()
            word.selection.typetext(dbbemerkung(m))
            word.selection.moveright()
        Next
    End Sub
    Private Sub db_lesen()
        'Dim conn As New OleDbConnection
        Dim cmd As New OleDbCommand
        Dim reader As OleDbDataReader
        Dim conn As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=W:\visual studio 2010\Projects\Kennw\kennw\kw.mdb;")
        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 dbnummer(k) > ind Then
                    fnummer(j) = ind
                End If
                '                dbid(k) = reader("ID")
                If IsDBNull(reader("PNutzer")) Then
                    dbnutzer(k) = ""
                Else
                    pnutzerold = reader("PNutzer")
                    dbnutzer(k) = reader("PNutzer")
                End If
                '                dbnutzer(k) = reader("PNutzer")
                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")
                    'aus = krypt(dbkennwort(k), "Test")
                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
                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
        kall = k
    End Sub
    Private Sub Button2_Click(ByVal sender As System.Object, _
      ByVal e As System.EventArgs) Handles Button2.Click
        Dim word As Object, strfehlertext As String, i As Integer, zz As Byte, lu As Integer
        'If txtnutzer.Text <> "" Then
        db_lesen()
        '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
        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"
        For i = 1 To kall
            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()
            lu = Len(dbbemerkung(i))
            'Select Case lu                                              prüfen
            '    Case Is >= 1000 : zz = zz + 20
            '    Case Is >= 900 : zz = zz + 19                          
            '    Case Is >= 800 : zz = zz + 18
            'End Select
            If Len(dbbemerkung(i)) > 100 Then
                zz = zz + 11
            Else
                zz = zz + 10
            End If
        Next
    End Sub
End Class

'Code Form4 ===================================================================

Imports System.IO
Imports System.Data
Imports System.Data.OleDb
Imports Microsoft.Win32
'Imports Microsoft.Office.Interop.Outlook
Imports Microsoft.Office.Interop
Public Class Form4
    Dim blnTMP As Boolean
    Dim adr(100) As String
    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)
        'OutlookPosteingang()
        Test()
    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 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
        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
        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 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
        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
        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"
        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
    End Sub
    Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button7.Click
        Dim objNameSpace As Object, test As String
        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
        ' 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 = 30
        ListView2.Columns(1).Width = 250
        ListView2.Columns(2).Width = 485
        ListView2.Columns(3).Width = 113
        ' 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
            ' Konstante für Gesendet
            'Const olFolderInbox = 5
            ' Objektvariable mit Posteingang belegen
            objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
            ' Wenn Mails im Posteingang sind, dann...
            test = objFolder.Items.Count
            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 = .to
                                mvon = .sendername
                                mname = .subject
                                'mname = .subject
                                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
        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 Listview2_Click(sender As Object, e As System.EventArgs) Handles ListView2.Click
        ausi = 1
        ausg(ausi)
    End Sub
    Sub Test()
        Dim test As String, test1 As String
        Dim oOutlookApp As Object
        Dim oNamespace As Object
        Dim oFolder As Object
        Dim oSubFolder As Object
        Dim ind As Integer
        ind = 0
        AbsenderEinlesen()
        test = benutzer(2)
        oOutlookApp = CreateObject("Outlook.Application")
        oNamespace = oOutlookApp.GetNamespace("MAPI")
        test = "Anzahl accounts: " & oNamespace.Accounts.Count
        For Each oFolder In oNamespace.Folders
            test1 = oFolder.Name
            For Each oSubFolder In oFolder.Folders
                ind = ind + 1
                Debug.Print(" " & oSubFolder.Name)
                adr(ind) = " " & oSubFolder.Name
                post()
                'hier posteingang lesen je Konto

                'For Each oMessage In oSubFolder.Items
                '    Select Case TypeName(oMessage)
                '        Case "MailItem"
                '            Debug.Print("  " & oMessage.Subject)
                '        Case Else
                '    End Select
                'Next
            Next
        Next
    End Sub

    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        Dim objNameSpace As Object, test As String
        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
        ' 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
        ListView1.View = View.Details
        ListView1.FullRowSelect = True
        ListView1.Items.Clear()
        With (ListView1.Columns)
            .Add("Nr")
            .Add("An")
            .Add("Betr.")
            .Add("Datum")
        End With
        ListView1.Columns(0).Width = 30
        ListView1.Columns(1).Width = 250
        ListView1.Columns(2).Width = 485
        ListView1.Columns(3).Width = 113
        ' 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 Gesendet
            Const olFolderInbox = 5
            ' Objektvariable mit Posteingang belegen
            objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
            ' Wenn Mails im Posteingang sind, dann...
            test = objFolder.Items.Count
            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 = .to
                                mname = .subject
                                'mname = .subject
                                mzeit = .receivedtime
                                mtext = .SenderEmailAddress & " / " & .SenderName & " / " & .ReceivedTime
                                'ListView2.Items.Add(mtext)
                                With ListView1.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 Sub Listview1_Click(sender As Object, e As System.EventArgs) Handles ListView1.Click
        'Dim smvon As Integer
        For Each SelItem As ListViewItem In ListView1.SelectedItems
            smvon = SelItem.Text
        Next
        Dim test As Integer
        Dim test1 As String
        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...
        RichTextBox2.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...
            test = objFolder.Items.Count
            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
                                    RichTextBox2.Text = .body
                                    'objItem.display(1)
                                    'WebBrowser1.Navigate(.htmlbody)
                                    '                                    WebBrowser1.Navigate(.body)
                                End If
                                mvon = .to
                                mname = .sendername
                                mzeit = .receivedtime
                                mtext = .SenderEmailAddress & " / " & .SenderName & " / " & .ReceivedTime
                            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
    Public Function AbsenderEinlesen() As String
        Dim a1 As Integer
        Dim objOutlook As Microsoft.Office.Interop.Outlook.Application
        Dim objMAPI As Microsoft.Office.Interop.Outlook.NameSpace
        Dim objAccount As Microsoft.Office.Interop.Outlook.Account
        Dim strAccounts As String
        objOutlook = New Microsoft.Office.Interop.Outlook.Application
        objMAPI = objOutlook.GetNamespace("MAPI")
        For Each objAccount In objMAPI.Accounts
            a1 = a1 + 1
            benutzer(a1) = objAccount.DisplayName
            strAccounts = strAccounts & objAccount.DisplayName & ";"
            'post()
        Next objAccount
        'objAccount = 4
        AbsenderEinlesen = strAccounts
    End Function
    Private Sub post()
        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
        ' 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 = 30
        ListView2.Columns(1).Width = 250
        ListView2.Columns(2).Width = 485
        ListView2.Columns(3).Width = 113
        ' 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
            ' Konstante für Gesendet
            'Const olFolderInbox = 5
            ' Objektvariable mit Posteingang belegen
            objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
            ' Wenn Mails im Posteingang sind, dann...
            'Test = objFolder.Items.Count
            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 = .to
                                mvon = .sendername
                                mname = .subject
                                'mname = .subject
                                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 Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        ausi = 2
        ausg(ausi)
        RichTextBox1.Text = merktext
    End Sub
    Private Sub ausg(ausi)
        'Dim smvon As Integer
        For Each SelItem As ListViewItem In ListView2.SelectedItems
            smvon = SelItem.Text
        Next
        Dim test As Integer
        Dim test1 As String
        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...
            test = objFolder.Items.Count
            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
                                    If ausi = 1 Then
                                        merktext = .body
                                        RichTextBox1.Text = .body
                                    End If
                                    If ausi = 2 Then
                                        objItem.display(1)
                                    End If
                                    mvon = .senderemailaddress
                                    mname = .sendername
                                    mzeit = .receivedtime
                                    mtext = .SenderEmailAddress & " / " & .SenderName & " / " & .ReceivedTime
                                End If
                            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
    End Sub
End Class