Excel 2013: Macro Email an jeden Empfänger mit aktuellem Datum

[Hansman]

Servus zusammen,

so schreibt man ja ne Email aus Excel herraus:

Sub Excel_Serienmail_via_Outlook_Senden()
    Dim OutApp As Object, Mail As Object
    Dim i As Integer
    Dim Nachricht
    For i = 1 To 10
    'Variablen müssen bei jeder Schleife neu initalisiert werden
        Set OutApp = CreateObject("Outlook.Application")
        Set Nachricht = OutApp.CreateItem(0)
        With Nachricht
            .To = Cells(i, 1)'Adresse
            .Subject = Cells(i, 2) 'Betreffzeile
            .Body = Cells(i, 3) 'Sendetext
            'Hier wird die Mail gleich in den Postausgang gelegt
            'und die Sicherheitsabfrage muss jedesmall bestätigt werden
            '.Send
            'Hier wird die Mail "angezeigt"
            'aber gleich versendet,... OHNE Sicherheitsabrage
            .Display
            SendKeys "%s",True
        End With
        'Variablen zurücksetzen sonst geht es nicht
        Set OutApp = Nothing 'CreateObject("Outlook.Application")
        Set Nachricht = Nothing 'OutApp.CreateItem(0)
        Application.Wait (Now + TimeValue("0:00:05"))
    Next i
End Sub

Wie krieg ich es jetzt hin, dass das Macro alle Zeilen in Spalte A nach dem aktuellen Datum durchsucht und nur den Leuten eine Email schreibt, die das aktuelle Datum drin haben?

Danke!

 

[TB30]

Eine Möglichkeit wäre:

Option Explicit

Sub sendMail()

    Dim OutApp As Object
    Dim Nachricht As Variant

    Dim myRange As Range
    Dim iCell As Range
    
    Set OutApp = CreateObject("Outlook.Application")
    
    'Range von A1 bis zur letzten Zeile wählen, in der noch Werte in Spalte A stehen '
    Set myRange = ThisWorkbook.Worksheets("Tabelle1").Range("A1:A" & Range("A1").End(xlDown).Row)
    
    'Range Zeile für Zeile durchgehen '
    For Each iCell In myRange
        If iCell.Value = Date Then 'Date gibt immer das aktuelle Datum zurück '
            Set Nachricht = OutApp.CreateItem(0)
            With Nachricht
                .to = Cells(iCell.Row, 2) 'Bei dir ist es Spalte 1, aber da steht ja schon das Datum drin '
                'usw... '
            'usw... '
        End If
    Next iCell
    
End Sub

Hilft dir das weiter?

 

[Hansman]

So ich krieg zumindest keine Fehlermeldungen mehr aber auch keine Email:

Sub Senden()

 Dim OutApp As Object
 Dim Nachricht As Variant

    Dim myRange As Range
    Dim iCell As Range
    
If MsgBox("Email an alle Empfänger senden?", _
   vbQuestion + vbYesNo, "Email an alle Empfänger senden?") = vbNo Then
   Exit Sub
   End If
   

    'Range von A1 bis zur letzten Zeile wählen, in der noch Werte in Spalte A stehen '
    Set myRange = ThisWorkbook.Worksheets("Umlagerung").Range("A1:A" & Range("A1").End(xlDown).Row)

    'Range Zeile für Zeile durchgehen '
    For Each iCell In myRange
        If iCell.Value = Date Then 'Date gibt immer das aktuelle Datum zurück '
            Set Nachricht = OutApp.CreateItem(0)
            With Nachricht
                .to = Cells(iCell.Row, 5)
                .Subject = "Ware eingetroffen"
                .body = "Hallo, für Sie ist Ware eingetroffen."
                SendKeys "%s", True
            End With
                End If
    Next iCell
  
    
     Set OutApp = Nothing
     Set Nachricht = Nothing
     Application.Wait (Now + TimeValue("0:00:05"))

End Sub

Wie krieg ich es hin, dass für jede Email auch noch die Daten, die in der Zeile mit drin stehen im Body landen?

 

[TB30]

Diesmal hast du...

Set OutApp = CreateObject("Outlook.Application")

...vergessen.

Wie krieg ich es hin, dass für jede Email auch noch die Daten, die in der Zeile mit drin stehen im Body landen?

Wenn ich dich richtig verstehe, müsstest du einfach nur die beiden Strings mit einem "&" verketten. Also z.B...

.body = "Hallo, für Sie ist Ware eingetroffen. " & Cells(iCell.Row, 6)

...wenn die individuelle Nachricht jeweils in Spalte F steht.

 

[Hansman]

Irgendwo muss der Hund noch begraben sein. Ich krieg 5 Sek. diesen drehenden Mauszeiger und dann is Ende und es passiert nix

Sub Senden()

 Dim OutApp As Object
 Dim Nachricht As Variant

    Dim myRange As Range
    Dim iCell As Range
    
If MsgBox("Email an alle Empfänger senden?", _
   vbQuestion + vbYesNo, "Email an alle Empfänger senden?") = vbNo Then
   Exit Sub
   End If
   
   Set OutApp = CreateObject("Outlook.Application")

    'Range von A1 bis zur letzten Zeile wählen, in der noch Werte in Spalte A stehen '
    Set myRange = ThisWorkbook.Worksheets("Umlagerung").Range("A1:A" & Range("A1").End(xlDown).Row)

    'Range Zeile für Zeile durchgehen '
    For Each iCell In myRange
        If iCell.Value = Date Then 'Date gibt immer das aktuelle Datum zurück '
            Set Nachricht = OutApp.CreateItem(0)
            With Nachricht
                .to = Cells(iCell.Row, 5)
                .Subject = "Ware eingetroffen"
                .body = "Hallo, für Sie ist das Material" & Cells(iCell.Row, 6) & "vom Lieferanten" & Cells(iCell.Row, 8) & "eingetroffen"
                SendKeys "%s", True
            End With
               End If
    Next iCell
  
    
     Set OutApp = Nothing
     Set Nachricht = Nothing
     Application.Wait (Now + TimeValue("0:00:05"))

End Sub

 

[TB30]

Ersetz mal noch das "SendKeys "%s", True" (Zeile 27) durch ein einfaches

 .send

Ich hab das Skript gerade mit dieser Änderung bei mir durchlaufen lassen und es landen tatsächlich Mails im Outlook-Postausgang. (Gesendet werden können Sie nicht, weil ich Outlook sonst nicht nutze und dementsprechend auch keine Mailserver konfiguriert habe.)

Übrigens bekommst du in Zeile 26 aktuell Texte wie diesen:

Hallo, für Sie ist das Materialxyzvom LieferantenMustermanneingetroffen

Soll heißen, du musst noch ein paar Leerzeichen in den String einfügen.

.body = "Hallo, für Sie ist das Material " & Cells(iCell.Row, 6) & " vom Lieferanten " & Cells(iCell.Row, 8) & " eingetroffen."

 

[Hansman]

Guten Morgen,

ich habe die dunkle Vermutung, dass die IT Makros auf andere Programme blockt...

mit .send geht's nämlich auch nicht.

 

[Onatik]

Dann probier es doch außerhalb deiner betrieblichen Umgebung! Was ist mit deinem Rechner? Läuft es denn da?

 

[soulreeper]

Guten Morgen,

ich habe die dunkle Vermutung, dass die IT Makros auf andere Programme blockt...

mit .send geht's nämlich auch nicht.

Evtl. auch eine Security-Lösung installiert, die das Ausführen blockt?

 

[Hansman]

Dann probier es doch außerhalb deiner betrieblichen Umgebung! Was ist mit deinem Rechner? Läuft es denn da?

... auf das bin ich jetzt ernsthaft nicht gekommen. Werd ich die Tage gleich mal testen.