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.
Halo Ronny,
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
WSh.Range(sBer).Copy ' Bereich kopieren
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2 '2=HTML-Format, 3=Richtext
.Subject = "Ihre Daten vom " _
& WSh.Cells(iZeile, "D").Value ' Betreff
.To = WSh.Cells(iZeile, "C").Value ' Empfänger
' .Cc = WSh.Cells(iZeile, "C").Value ' Kopie
sMailtext = "Hallo " _
& WSh.Cells(iZeile, "B").Value & "," & vbLf & vbLf _
& "anbei Deine Daten:" & vbLf & vbLf
.Getinspector: sSignatur = .htmlbody ' Signatur holen
.htmlbody = Replace(sMailtext, vbLf, "<br>") & .htmlbody
.Display
iEinf = Len(sMailtext) ' Grafik Einfügestelle
With .Getinspector.WordEditor.Application.Selection
.Start = iEinf: .End = iEinf
.Paste ' Bereich in Mail einfügen
End With
End With
End Sub
_________
viele Grüße
Karl-Heinz
Hallo Karl Heinz,
vielen Dank für deine Rasche Antwort.
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).
Grüße,
Ronny
Hallo Ronny,
zunächst einmal wünsche ich ein gutes und gesundes Jahr 2021.
Hier noch mal ein Update, mit dem es möglich ist, auch mehrere Mails automatisiert zu erstellen.
Hierzu einfach im Datenschnitt die gewünschten Nutzer auswählen und den Button klicken.
Ohne, dass Outlook aufgeht, wird es nicht funktionieren.
Du kannst die Schrift auch formatieren....
viele Grüße
Karl-Heinz
Hallo Karl-Heinz,
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!
Besten Gruß,
Ronny
Hallo Ronny,
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)
sBer = "D5:G5,D" & iBeginn & ":G" & iEnde ' Kopierbereich setzen
WSh.Range(sBer).Copy ' Bereich kopieren
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2 ' 2=HTML-Format
sBetreff = WSh.Cells(iBeginn, "D").Value ' Betreff zusammenbauen
If sBetreff <> WSh.Cells(iEnde, "D").Value Then
sBetreff = WSh.Cells(iEnde, "D").Value _
& " bis zum " & sBetreff
End If
.Subject = "Ihre Daten vom " & sBetreff ' Betreff
.To = sEmpfaenger ' Empfänger
With WSh.Cells(iBeginn, "A")
sMailtext = "Sehr geehrte" & IIf(.Value = "Herr", "r ", " ") _
& .Value & " " _
& .Offset(, 1).Value & "," _
& "Anbei Ihre Daten:"
End With
iEinf = Len(sMailtext) ' Grafik Einfügestelle
sMailtext = "<body style='font-family:Arial; font-size:10pt;color:#000000'>" _
& sMailtext & "</body>" ' Schrift formatieren
.Getinspector: ' Signatur holen
.htmlbody = Replace(sMailtext, "", "<br>") & .htmlbody
.Display ' Mail anzeigen
On Error Resume Next
Do
Err = 0
Sleep 100
WSh.Range(sBer).Copy ' Bereich kopieren
If Err = 0 Then Exit Do
Loop
With .Getinspector.WordEditor.Application.Selection
.Start = iEinf: .End = iEinf
.Paste ' Bereich in Mail einfügen
End With
.sent ' Mail absenden
End With
End Sub
_________
viele Grüße
Karl-Heinz
Moin Karl-Heinz!
Tippfehler:
.Send statt .Sent
Gruß Ralf
Jo Ralf. danke für den Hinweis.
Einfach aus dem vorherigen Beitrag abgeschrieben und nicht weiter nachgedacht.
VG KH
Hallo zusammen,
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.
Danke für die Rückmeldung Ronny, das ist lieb.
Man will ja auch wissen, ob's was gebracht hat
Und viel Erfolg noch.
viele Grüße
Karl-Heinz