30.12.2020, 17:50 (Dieser Beitrag wurde zuletzt bearbeitet: 30.12.2020, 17:59 von WutKnut.)
Hallo zusammen,
ich habe für meine Erfahrungen eine gefühlte Mammut Aufgabe und leider nichts wirklich passendes bis lang gefunden. Nun seit ihr meine Hoffnung. Ich kenne mich bereits ein wenig mit Formeln und co aus, aber auf diesem Gebiet bin ich absoluter Neuling.
Hier meine Wunschvorstellung:
Ich habe eine Datei (hier angehangen als Beispiel.xlsx). Dort stehen in einer Tabelle mehrere Nutzer mit verschiedenen Daten und Beispiel Datum.
Die Aufgabe besteht nun darin, diesen Nutzer, die Daten aus den Spalten Datum bis Feld 3 via Email zuzusenden. Am besten in dem Format, wie Sie auch in der Tabelle stehen. Allerdings gibt es ein paar Kriterien:
- Es sollen nur die Daten gesendet werden, die in einem gefilterten Datum liegen (ein oder mehrere Tage). Die Filter werden entsprechend über die Datenschnitte gesetzt. - Es soll jeder Nutzer nur seine Daten von diesem Tag erhalten. Als Beispiel: Ich klicke auf den 29. Dez. Diese Daten sollen nun an die jeweiligen Nutzer gesendet werden. -> Nutzer 1 soll die Tabelle mit den Spalten Datum bis Feld 3 erhalten und die beiden Zeilen in denen er notiert ist -> Nutzer 2 und 3 sollen das gleiche mit Ihren Daten bekommen -> keiner der Nutzer soll die anderen Daten der anderen beiden sehen
Die Mails sollten sofern möglich auf einmal an alle 3 Nutzer geschickt werden. Am Anfang gern als geöffnete Email die manuell geschickt werden muss. Sofern ich sichergehen kann das alles funktioniert, können diese Emails dann auch ohne meine Bestätigung verschickt werden.
Die gewünschte Email-Vorlage hab ich auch nochmal als Screenshot angehangen.
Zum Hintergrund, es geht hier in meiner Praxis natürlich nicht um 1-4 Personen sondern hunderte. Durch diese Automatisierung erhoffe ich mir einen enormen Zeitvorteil, da ich die Daten nicht nach Nutzer filtern und manuell in die Email kopieren muss.
Ich hoffe ich konnte euch meinen Traum etwas näher bringen und Ihr habt Ideen, wie ich dies (vielleicht auch nur in Teilen) umsetzen kann.
Lieben Gruß, Ronny
PS: Gerade bemerkt, dass am 29. Dez Nutzer 2 gar nicht auftaucht :D Überschreibt einfach einmal Nutzer 3 auf Nutzer 2 dann passt meine Schilderung oben wieder. Entschuldigung dafür.
hier mal ein Ansatz, eine Idee, wie Du das angehen könntest.
Derzeit wird jedoch immer nur an den einen Empfänger gesendet, der als erstes sichtbar ist.
Wenn eMails an alle sichtbaren Empfänger getrennt und in einem Rutsch gesendet werden sollen, muss das in einer Schleife mit erweitertem Code ablaufen. Dafür habe ich gerade keine Zeit mehr.
Eine Mammutaufgabe eben.
Schau einfach mal, ob Du damit schon etwas anfangen kannst....
Code:
Option Explicit Option Compare Text
Sub Mail_Senden() 'Sendet Mail mit integriertem Bereich als Bereich mit Signatur Dim WSh As Worksheet Dim sMailtext As String, sSignatur As String Dim sBer As String, iEinf As Integer, iZeile As Long
Set WSh = ThisWorkbook.Sheets("Beispiel") 'Blatt mit Maildaten und Daten iZeile = WSh.Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Zeile in Spalte sBer = "D5:G" & iZeile ' Kopierbereich
For iZeile = 6 To iZeile ' erste relevante Zeile ermitteln If WSh.Rows(iZeile).Hidden = False Then Exit For If WSh.Cells(iZeile, "C") = "" Then Exit Sub Next iZeile
Ich habe etwas mit deiner Vorlage herum experimentiert (Texte, Spalten etc angepasst) und bin schon wieder schier begeistert von dir!
Es tut grundlegend genau das was du gesagt hast und was es tun soll. Email geht auf, Text geht rein und ich kann es abschicken. Einziger "Minuspunkt" ist, dass Zeitrahmen im Subject nicht gesetzt werden sondern immer nur das jüngste Datum. Hier möchte ich mich aber nicht beschweren, da dies jammern auf hohem Niveau wäre :D
Wie ich die Emails nun verschicken kann ohne das Outlook erst auf geht versuche ich allein herauszufinden. Sofern du Zeit hast die "Upgrade"-Version zu basteln (und ich diese hoffentlich auch verstehe) wär das natürlich Mega.
Noch einmal vielen lieben Dank und schon einmal einen Guten Rutsch ins neue Jahr! (natürlich auch den fleißigen Rest hier).
vielen Dank für deine Mühen. Ich habe in deine Datei mal reingeschaut aber noch nicht auf meine originale angewand. (Werde ich aber so bald wie möglich tun).
Wegen dem senden: Outlook ist die ganze Zeit geöffnet.
Ich habe auch mit dem .sent befehl experimentiert. Da versendet er die Emails zwar, aber irgendwie kopiert er nicht die Werte in die Email. Der Rest (Email-Adresse, Name, Text und selbst die Signatur) sind in der Email enthalten. Nach langen Kopfschütteln und mich selbst fragen bin ich dann erst einmal ins Wochenende gestartet :D
Wenn du noch eine Idee hast, wo ich den .sent Befehl einbauen kann wäre dies ein Traum. Sobald ich dein Macro auf die original-Datei angewendet habe gibts auch wieder eine Rückmeldung.
Danke noch einmal, dass du dir die Zeit genommen hast!
bei mir läuft es problemlos. Vielleicht sind bei Dir auch Zeitprobleme.
Hier mal ein etwas erweiterter Code mit Zeitverzögerung und Fehlerabfang bzgl. des Kopierens und Einbau des .Sent.
Code:
Option Explicit Option Compare Text
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Mail_Senden() ' Abarbeiten der einzelnen, gewünschten Mails lt. Filter Dim oSI As Object Dim i As Integer, sItems As String, sArr() As String
With ActiveWorkbook.SlicerCaches("Datenschnitt_Name") For Each oSI In .SlicerItems If oSI.Selected = True Then sItems = sItems & oSI.Name & "," ' gewünschte Nutzer sammeln End If Next oSI If sItems = "" Then Exit Sub sArr = Split(sItems, ",") ' Daten ins Array
For i = 0 To UBound(sArr) - 1 .ClearManualFilter ' Filter zurück setzen For Each oSI In .SlicerItems ' Alle Items durchgehen If Not sArr(i) Like oSI.Name Then oSI.Selected = False ' Item abwählen End If Next oSI Mail_SendenEx ' Jetzt die Mail erstellen Next i End With End Sub
Sub Mail_SendenEx() 'Sendet Mail mit integriertem Bereich als Bereich mit Signatur Dim WSh As Worksheet, sBer As String Dim sMailtext As String, sBetreff As String, sEmpfaenger As String Dim iEinf As Integer, iZeile As Long, iBeginn As Long, iEnde As Long
Set WSh = ThisWorkbook.Sheets("Beispiel") ' Blatt mit Maildaten und Daten iZeile = WSh.Cells(Rows.Count, "B").End(xlUp).Row ' Letzte Zeile in Spalte
For iZeile = 6 To iZeile ' erste relevante Zeile ermitteln If WSh.Rows(iZeile).Hidden = False Then If InStr(sEmpfaenger, WSh.Cells(iZeile, "C").Value & ";") = 0 Then sEmpfaenger = sEmpfaenger & WSh.Cells(iZeile, "C").Value & ";" End If If iBeginn = 0 Then iBeginn = iZeile iEnde = iZeile End If Next iZeile If sEmpfaenger = "" Then Exit Sub ' Kein Empfänger =>raus sEmpfaenger = Left$(sEmpfaenger, Len(sEmpfaenger) - 1)
ich wollte kurz nochmal ein Lebenszeichen von mir geben :) Ich hab es leider noch nicht zeitlich geschafft das 2te Makro einzuarbeiten. Das erste jedoch funktioniert super und die Senden-Funktion nun auch. Ich hatte den Fehler gemacht, das .display auszukommentieren
Ich melde mich noch einmal wenn ich den zweiten Code übernommen habe.