Gefilterte Tabelle via Email senden

[WutKnut]

So als kleines Update. 
50% habe ich funktionsfähig bekommen (klingt doof aber ich erkläre es mal)

Ich habe dein Code kopiert und nun 2 Makros, "Mail_senden" und "Mail_sendenEx".
Ich habe erst einmal nur die Datenspalten und co angepasst aber nicht den Inhalt der Email.

Nun das "Problem": Wenn ich das Macro "Mail_SendenEx" ausführe läuft alles wie gewollt. (Allerdings kopiert Excel nun alle Email-Adressen und alle Daten).
Ich geh mal davon aus, dass kommt davon, weil ich die "Mail_Senden" ausführen muss. 

Hier allerdings bekomme ich eine Fehlermeldung:

Laufzeitfehler '5':
Ungültiger Prozeduraufruf oder ungültiges Argument

Okay, ich hab vermutlich was falsch gemacht. Also klick ich auf "Debuggen"...

Code:

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_Komplett")
     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

Die Zeile "With ActiveWorkbook.SlicerCaches("Datenschnitt_Komplett")" wird dann gelb markiert.
Ich habe hier nur den namen des Datenschnittes ausgetaucht. Mehr nicht. 

Kannst du bitte nochmal schauen was ich da kaputt gemacht hab? :D 
Ich finde es leider nicht.

[WutKnut]

Fehler gefunden. 
Datenschnitt Name ist nicht zwangsweise die Beschriftung^^
Allerdings kopiert er die Email jetzt alle in eine (also alle empfänger + alle Daten).

Ich drück mal den Resetknopf und taste mich nochmal Schritt für Schritt ran :)

[volti]

Hi Ronny,

Namen des Datenschnittes ausgetauscht, nur im Makro oder auch das Objekt selbst?
Nur im Makro geht natürlich nicht. Da wird der datenschnitt ja nicht mehr gefunden...


Ansonsten bitte mal die neueste Datei hier hochladen...

Noch mal zum Ablauf.
Mail_SendenEx erstellt die Mail für die aufgrund des Datenschnitts sichtbaren Zeilen. 
Mail-Senden stellt nach und nach die gewünschten Bereiche im Datenschnitt ein und erstellt dann via Mail_SendenEx die jeweilige Mail.

VG KH

[WutKnut]

"Namen des Datenschnittes ausgetauscht, nur im Makro oder auch das Objekt selbst?
Nur im Makro geht natürlich nicht. Da wird der datenschnitt ja nicht mehr gefunden..."

Der Name oder besser die Beschriftung. Sprich im Datenschnitt stand "B", der Name davon war aber "A".
In deine Arbeit hab ich (weil ich ja immer vom besten ausgehe :D ) "B" rein geschrieben.

[WutKnut]

So hallo noch einmal.

Wenn man von etwas 0 Ahnung hat ist es manchmal echt schwer Dinge umzusetzen :D
Aber ich habe es nun geschafft und die Emails werden automatisch versendet. Das ist einfach genial und noch einmal 100 Danke an dich Karl Heinz. :)

Aber -.-**

Meine Gurke von Computer schafft scheinbar das nicht richtig. Ergo bei 2 von 3 versuchen stürzt Excel bei mir ab.
Aus diesem Grund wollte ich die beiden Makros kombinieren. Erwartetet Ergebnis: ich scheitere :D

Ich hab leider nicht wirklich einen Plan, wie das eine in das andere greift. 
Könntest du bitte so lieb sein und mir das noch einmal wie folgt anpassen?

Das erste Makro funktioniert einwandfrei. Der Emailversand soll also nach jeder Auswahl einzeln erfolgen.
Das Datum bzw. den Zeitraum würde ich gern in das Subject mit rein nehmen. 
(Ich weis nicht ob ich das beeinflussen kann aber manchmal stand das höhere Datum vorn. Z.b. Deine Daten vom 06.01.2021 bis zum 03.01.2021)

Eine Persönliche Ansprache der Mitarbeiter mit Herr und Frau brauch ich nicht. Das könnte wiederrum raus. 
Wenn ich die Teile aus dem "Betreff zusammenbauen" vom "neuen" ins alte kopiere klappt dies leider nicht.

Danke noch einmal für deine Hilfe und besten Gruß,
Ronny

[volti]

Hallo Ronny,

teste mal, ob's jetzt besser passt.
PS: Bei mir stürzt der Rechner nicht ab...

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, sBetreff1 As String, sBetreff2 As String
 Dim 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

 With CreateObject("Outlook.Application").CreateItem(0)
     .BodyFormat = 2                                ' 2=HTML-Format
     sBetreff1 = WSh.Cells(iBeginn, "D").Value      ' Betreff zusammenbauen
     sBetreff2 = WSh.Cells(iEnde, "D").Value

     If sBetreff1 <> sBetreff2 Then
        If CDate(sBetreff1) > CDate(sBetreff2) Then
           sBetreff1 = sBetreff2 & " bis zum " & sBetreff1
        Else
           sBetreff1 = sBetreff1 & " bis zum " & sBetreff2
        End If
     End If
     .Subject = "Ihre Daten vom " & sBetreff1       ' Betreff
     .To = sEmpfaenger                              ' Empfänger

     With WSh.Cells(iBeginn, "A")
         sMailtext = "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

Rem     .Send                                        ' Mail absenden

 End With
 Sleep 500

End Sub

_________
viele Grüße
Karl-Heinz

[WutKnut]

Hallo Karl Heinz, 

beindruckt Runde 3.
Ich teste es sobald ich wieder etwas Luft habe.

Wegen dem Absturz das hat glaube nichts mit deinem Makro zu tun. Es ist einfach der Computer bzw. sein alter.
Ich melde mich wie gehabt sobald ich Luft finde.

[WutKnut]

Ich war neugierig und konnte nicht abwarten :D

Beim kopieren ist mir aufgefallen, dass es ja wieder die "große" Geschichte ist wo mehrere Mitarbeiter "verarbeitet" werden. 
Ich habe versucht den Code zu übernehmen, stelle aber leider 2 Dinge fest:

1.) Die Verarbeitung dauert durch Vorbereitung der Daten sehr lange (was natürlich an dem Umfang + Rechenleistung liegen kann).
2.) Warum auch immer, sortiert Excel nicht mehr aus. Es ist aktuell so, dass alle Daten, an die oberste Person geschickt werden.
3.) Excel erstellte gerade 5 Emails (vermutlich für 5 Zeilen in der Tabelle) korrigiere, er hört nicht mehr auf damit emails zu schreiben :D
4.) Das Datum wird im Bereich nicht korrekt angezeigt.

Ich habe einmal 2 Testaccounts gemacht und es dauerte ca. 3 Minuten vom druck auf das Knöpfchen bis zum Anzeigen von 2 Emails (und nun poppt alle 2-3 Minuten eine email auf) :D

Wenn ich die Mitarbeiter einzeln durchgehe, ist die Erstellung und das senden bin in 1-2 Sekunden erledigt.

Kannst du bitte das noch einmal so anpassen wie in dem Post beschrieben? (Jeden einzeln anklicken, aber mit Datumsformat) :D

GGf. schaffe ich es auch einmal die Datei exceltechnisch "rein" zu machen und lade sie dann hier hoch. Da muss ich nur Tonnenweise annonymisieren.

[volti]

Habe Dir eine PN geschickt....

[WutKnut]

Hallo Karl Heinz,

hier ist mein Nemesis. 
Wunder dich bitte nicht über das aussehen. Ich hab alles entfernt, was nicht für das Makro von Bedeutung ist (sind doch ein paar Formeln drin).
Gesendet werden soll der graue Block ganz rechts (aber natürlich nur die Daten eines Users an den User).

Um das ganze jungfreulich zu gestalten, habe ich auch alle meine Versuche gelöscht das Makro umzusetzen.
Ich gehe davon aus, dass dein Code auch wieder funktioniert (die davor haben es ja auch getan) und dass ich nur etwas falsch mache (was ich leider nicht sehe).

Was die "Performance" von meinem Rechner anbelangt musst du dir die Datei bzw. die Tabelle etwas größer vorstellen.
Mit insgesamt mehreren hundert Einträgen bei "MA Daten" und tausende Zeilen in der Tabelle "Übersicht".

Solange ich den "Filter" vordefiniere und nur dein erstes Makro nutze, gehen die Emails raus wie warme Semmeln. 
Mit der (ich nenne es mal so) Massenverarbeitung, braucht mein Excel 2-3 Minuten pro Email. 

Besten Gruß,
Ronny