Info wenn in einer der Tabellen Abgabedatum >8 ist

Hallo zusammen, erneut melde ich mich hier da ich zu unfähig bin mit VBA zu arbeiten. Oberschlupf konnte mir schon enorm weiterhelfen doch hab ich nun ein neues Problem.

Im Anhang findet ihr die Datei, welche 20 Tabellen beinhaltet.
Jede dieser Tabellen steht für eine Person, die Unterlagen dieser Person wir Zeitglich immer von zwei Institutionen Beurteilt, wenn eine Institution die Unterlagen länger als 8 Tage bei sei hat sollte ich beim öffnen der Excel-Datei eine Mail öffnen welche angibt:

Bei welcher der 20 Personen eine Institution die Unterlagen bereits länger als 8 Tage hat.

Wenn jemand mir dahin gehend einen Tipp geben könne wie man so etwas bewerkstelligen kann wäre ich sehr Dankbar.

Lg Oliver

https://www.herber.de/bbs/user/167243.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo

in DieseArbeitsmappe



Private Sub Workbook_Open()

    Dim TB As Worksheet, iLR As Integer, I As Integer, iZ1 As Integer, iSp As Integer

    Dim emailTo As String, iDiff As Integer, strNachricht As String, iAnz As Integer

    

    emailTo = "deinName@Firma.de"

    iZ1 = 4 'Erste Datenzeile

    iSp = 2 'Vergleichsdatum steht in B

    iDiff = 8

    

    For Each TB In ThisWorkbook.Sheets

        iLR = TB.Cells(TB.Rows.Count, iSp).End(xlUp).Row 'letzte Zeile der Spalte

        

        For I = iZ1 To iLR

            If TB.Cells(I, iSp) > "" And Date - TB.Cells(I, iSp) > iDiff Then

                strNachricht = strNachricht & TB.Cells(I, 1) & " hat: " & TB.Name & " länger als " & iDiff & " Tage." & vbLf

                iAnz = iAnz + 1

            End If

        Next

    Next

    If iAnz > 0 Then

        Call EmailSenden(emailTo, "Mitarbeiter schlafen", strNachricht)

    End If

End Sub

in ein Modul



Sub EmailSenden(strTo, strSub, strBody)



    Dim objOutlook As Object

    Dim objMail As Object

    

    Set objOutlook = CreateObject("Outlook.Application")

    Set objMail = objOutlook.CreateItem(0)

    

    With objMail

       .To = strTo

       .Subject = strSub

       .Body = strBody

       '.Send        'Sendet die Email automatisch

       .Display      'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend manuell vom User!

    End With



End Sub

LG UweD

Private Sub Workbook_Open() Dim TB As Worksheet, iLR As Integer, I As Integer, iZ1 As Integer Dim emailTo As String, iDiff As Integer, strNachricht As String, iAnz As Integer emailTo = "deinName@Firma.de" iZ1 = 4 'Erste Datenzeile iDiff = 8 For Each TB In ThisWorkbook.Sheets iLR = TB.Cells(TB.Rows.Count, 4).End(xlUp).Row 'letzte Zeile der Spalte D For I = iZ1 To iLR If TB.Cells(I, 4) > "" And TB.Cells(I, 4) > iDiff And TB.Cells(I, 5) = "" Then strNachricht = strNachricht & TB.Cells(I, 1) & " hat: " & TB.Name & " länger als " & iDiff & " Tage." & vbLf iAnz = iAnz + 1 End If Next Next If iAnz > 0 Then Call EmailSenden(emailTo, "Mitarbeiter schlafen", strNachricht) End If End Sub

Beliebteste Forumthreads (12 Monate)

Info wenn in einer der Tabellen Abgabedatum >8 ist

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Info wenn in einer der Tabellen Abgabedatum >8 ist

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread