ich arbeite schon sehr lange (mit einer längeren Pause) an einem Problem und bin auch bereit, nach diesem letzten Versuch aufzugeben. Vielleicht ist hier noch ein netter Tüftler. Ich hatte das Problem auch schon in Foren veröffentlicht, hatte aber immer wieder eine Fehlermeldung bekommen. Jetzt versuche ich es so detailliert wie möglich zu beschreiben.
Ausgangssituation:
Ich arbeite für einen sozialen Träger, der Dienstleistungen am Klienten anbietet. Dafür wird über einen bestimmten Zeitraum von einem Auftraggeber Arbeitszeitstunden angeboten, die eine Fachkraft bedient, und es muss vor Beendigung der Maßnahme ein Bericht angefertigt werden.
Hier die Mappe in sehr abgespeckter Version, da sie sonst zu groß ist:
https://www.herber.de/bbs/user/105859.xlsx
Problembeschreibung:
Der Job ist für Mitarbeiter sehr stressbelastet, was dazu führen kann, dass Mitarbeiter immer wieder die bewilligten Arbeitszeitstunden überziehen und auch der Bericht vergessen wird rechtzeitig anzufertigen.
Lösung:
EXCEL .Die angefertigte Excelmappe hilft dabei. Die Bewilligten Stunden werden monatlich berechnet und durch bedingte Formatierung werden Warnungen angezeigt, die mich darauf hinweisen, dass die Stunden bald ablaufen, oder Berichte anzufertigen sind. Funktioniert gut
Der Mitarbeiter wird dann von mir per Mail gewarnt und es konnten schon einige Überziehungen verhindert werden.
Jetzt möchte ich allerdings einen Schritt weiter gehen.
Ich habe mich schon durch sämtliche Foren gekämpft und diverse Lösungen ausprobiert. Komme aber nicht zu einer Lösung (Hätte es fast geschafft, aber dann war das VBA zu lang)
Folgendes soll via VBA umgesetzt werden:
Wenn in Zelle N4 die Stundenzahl unter 20 beträgt, soll automatisch (mit vorgegebenen Text und nach Drücken auf den Button E-Mail Senden) eine Mail an den Adressaten in Zelle R4 versendet werden. Funktioniert auch wenn ich es wie folgt aufbaue:
Sub e_mailSenden()
Dim olApp As Object
Dim objMail As Object
If Range("N4").Value 0 Then
Set olApp = CreateObject("Outlook.Application")
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.To = Sheets("Fallübersicht").Range("R4").Value
.Subject = "Achtung Poolstunden bald aufgebraucht"
.Body = "Liebe Kollegin/Lieber Kollege," & vbNewLine & vbNewLine & "der Stundenpool bei " & Sheets("Fallübersicht").Range("B4").Value & " weißt nur noch " & Sheets("Fallübersicht").Range("N4").Value & " Reststunden auf." & vbNewLine & "Dies ist eine automatische Benachrichtigung."
.Display 'zeigt die Mail nur an - du musst auf Senden klicken
'.Send 'legt die Mail gleich in den Postausgang
End With
End If
Zudem wird in Zelle O4 ein Status abgefragt. Bei zutreffen erscheint dort Bericht fällig. Auch hier soll eine Meldung erfolgen.
Auch dies funktioniert, wie folgt:
If Range("O4").Value = "Bericht fällig" Then
Set olApp = CreateObject("Outlook.Application")
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.To = Sheets("Fallübersicht").Range("R4").Value
.Subject = "Achtung Bericht fällig"
.Body = "Liebe Kollegin/Lieber Kollege," & vbNewLine & vbNewLine & "die Hilfemaßnahme bei " & Sheets("Fallübersicht").Range("B4").Value & " läuft bald aus und der Bericht ist somit fällig." & vbNewLine & "Dies ist eine automatische Benachrichtigung."
.Display 'zeigt die Mail nur an - du musst auf Senden klicken
'.Send 'legt die Mail gleich in den Postausgang
End With
End If 'Ende Zeile
Mein Problem war (und ist) an dieser Stelle, dass die Befehle sich für die weiteren Zeilen wiederholen und ich kein zusammenfassendes VBA hinbekommen habe (es gab immer Fehlermeldung). Somit kam ich auf die glorreiche Idee, Das VBA immer wieder zu Kopieren. Als ich fertig war, bekam ich die Fehlermeldung, dass das VBA zu lang sei. Somit benötige ich eine kürzere Lösung. So jetzt solltet ihr mein Problem kennen. Ich benötige ein wie oben beschriebenes VBA, dass für den Zellenbereich Buchstabe4 : Buchstabe103 funktioniert.
Habt Ihr eine Idee?