Info wenn in einer der Tabellen Abgabedatum >8 ist

Forumthread: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 14:05:38

Huuii

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

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 14:11:45

onur

Lies bitte diesen Satz langsam durch, als ob du ihn nicht selber geschrieben hättest, und schreibe bitte dann auf, was damit gemeint sein könnte.
"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.""

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 14:25:52

Huuii

*
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 sich hat, sollte sich beim öffnen der Excel-Datei eine Mail öffnen welche angibt:

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

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 14:26:03

UweD

Hallo

an welchem Datum willst du die 8 Tage denn festmachen?

In keinen Tabelle, in keiner Zelle ist ein Fix eingetragenes Datum enthalten.
Nur die Heute() Formel und die ändert sich bei jedem öffnen immer auf den aktuellen Tag

LG UweD

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 14:33:32

Huuii

In der Spalte B wäre immer eine Abgabedatum eingetragen, sofern diese nicht leer bleibt sollte die zuständige Person aus dieser Zeile bei mir in der Mail erscheinen sofern >8. Damit ich einen Überblick beim öffnen der Datei habe bei welcher Person und Institution die Unterlagen nun liegen.

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 14:48:43

onur

Im Prinzip so:
https://www.herber.de/bbs/user/167245.xlsm

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 14:56:11

UweD

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

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 15:10:55

Huuii

Omg ja, genau so :))), Tausend Dank

Darf ich noch etwas anderes Fragen, wie ist es möglich; in jeder Tabelle neben der Mailadresse einen Button einzufügen der auf klick eine Mail an diese Stelle sendet mit Wunsch Text?

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 15:25:06

UweD

Eine Möglichkeit wäre
Ohne zusätzlichen Button...

Rechstklick auf die mailadresse, Hyperlink bearbeiten, dort bei Betreff deinen Wunschtext hinterlegen.
Dann kannst du später ganz normal auf die mailadresse tippen.

LG Uwe

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 15:26:35

Huuii

Ok, dann versuch ich dies mit Hyperlink

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 15:21:14

Huuii

Lieber Uwe, ich hätte doch noch eine weitere Frage: Wie kann ich es abstellen, wenn inzwischen die Unterlagen zurückgekommen sind, dass diese unterlagen nicht mehr in der Mail erscheinen, sobald etwas in Spalte E eingetragen ist.

AW: Info wenn in einer der Tabellen Abgabedatum >8 ist

22.02.2024 15:43:14

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

LG UweD

Beliebteste Forumthreads (12 Monate)

Info wenn in einer der Tabellen Abgabedatum >8 ist

Forumthread: Info wenn in einer der Tabellen Abgabedatum >8 ist

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread