EMail an mehrere Empfänger in Excel Liste

Bild

Betrifft: EMail an mehrere Empfänger in Excel Liste
von: Marcel
Geschrieben am: 03.09.2015 14:11:12

Hallo,
bin nicht so gut mit VBA Codes, deshalb die Frage.
Möchte an x Personen die in jeder zweiten Spalte meiner Tabelle stehen, eine Mail mit dem Inhalt der Zeilen unter der EMail Adresse schicken.. sprich
AE5 Empfänger1@mail.com
AE6 Daten Empf1
AE7 Daten Empf1
AE50 Daten Empf1
AG5 Empfänger2@mail.com
AG6 Daten Empf2
AG7 Daten Empf2
AG50 Daten Empf2
usw...
etwa 50 verschiedene Empfänger mit jeweils verschiedenen Daten.
habe unten stehenden Code im Netz gefunden. Dieser ermöglicht mir eine Mail an eine festgelegte Email Adresse zu verschicken. Problem hierbei ist jedoch, dass ich die Adressen & den Bereich in dem die Daten stehen ja immer wieder neu eingeben muss.
Jemand ne Idee, wie man das vereinfachen könnte?

Sub Excel_Range_via_Outlook_Senden()
     Dim OutApp As Object, Mail As Object, i
     Dim Nachricht
     'Verweis auf "Microsoft Forms 2.0 Object Library" aktivieren !!
     'sonst geht es nicht
     'Dataobject wird gebraucht wegen der Zwischenablage
     Dim ClpObj As DataObject
     For i = 1 To 1
         Set ClpObj = New DataObject
         Set OutApp = CreateObject("Outlook.Application")
         Set Nachricht = OutApp.CreateItem(0)
         'Excelbereich der versendet werden soll.
 'Wenn kein Bereich versendet werden soll sondern
 'der Bereich bereits kopiert wurde, können sie die
 'nächsten beiden Zeilen auskommentieren
         Range("AE5:AE20").Select
         'Bereich wird in die Zwischenablage kopiert
         Selection.Copy
         With Nachricht
             .Subject = "Arbeitspaket"
             'Zwischenablage wird eingefügt
             ClpObj.GetFromClipboard
             .Body = ClpObj.GetText(1)
             .To = "beispielmail@beispiel.com"
             'Hier wird die Mail angezeigt
             '.Display
             'Hier wird die Mail gleich in den Postausgang gelegt
             .Send
         End With
         Set OutApp = Nothing
         Set Nachricht = Nothing
         'Auf Outlook warten. Ist nicht schnell genug :-))
         Application.Wait (Now + TimeValue("0:00:05"))
     Next i
End Sub

Bild

Betrifft: AW: EMail an mehrere Empfänger in Excel Liste
von: fcs
Geschrieben am: 04.09.2015 07:27:18
Hallo Marcel,
probiere es mal mit folgender Anpassung.
In einer Schleife werden die Spalten ab AE in 2er-Schritten abgearbeitet und die entsprechenden Zellbereiche verarbeitet.
Den Body-Text könnte man auch aus den Zellbereichen zusammen bauen, statt über das Clipboard-Objekt zu gehn.
Outlook startest du am besten bevor du in Excel das Makro startest.
Die Wartezeit zwischen den E-Mails kannst du wahrscheinlich reduzieren.
Gruß
Franz

Sub Excel_Range_via_Outlook_Senden()
    'Verweis auf "Microsoft Forms 2.0 Object Library" aktivieren !!
    'sonst geht es nicht
    'Dataobject wird gebraucht wegen der Zwischenablage
    Dim ClpObj As DataObject
    'Outlook-Objekte
    Dim OutApp As Object, Mail As Object
    Dim Nachricht
    Dim varEmpf, strBody As String
    
    Dim wks As Worksheet, rngData As Range
    Dim Spalte As Long, Spalte_L As Long, Zeile_L As Long
    
    Set wks = ActiveSheet
    
    Set OutApp = CreateObject("Outlook.Application")
    Set ClpObj = New DataObject
    
    With wks
        'letzter Empfänger in Zeile 5
        Spalte_L = .Cells(5, .Columns.Count).End(xlToLeft).Column
        
        For Spalte = .Range("AE5").Column To Spalte_L Step 2
            Zeile_L = .Cells(.Rows.Count, Spalte).End(xlUp).Row
            varEmpf = .Cells(5, Spalte).Text
            If Zeile_L >= 6 Then
                'Datenbereich für E-Mail ab Zeile 6 setzen
                Set rngData = .Range(.Cells(6, Spalte), .Cells(Zeile_L, Spalte))
                'Bereich wird in die Zwischenablage kopiert
                rngData.Copy
                ClpObj.GetFromClipboard
                strBody = ClpObj.GetText(1)
            Else
                Set rngData = Nothing
                strBody = "keine Nachrichten"
            End If
            'Nachricht erstellen in Outlook
            Set Nachricht = OutApp.CreateItem(0)
            With Nachricht
                .Subject = "Arbeitspaket"
                'Zwischenablage wird eingefügt
                .Body = strBody
                .To = varEmpf
                'Hier wird die Mail angezeigt
                '.Display
                'Hier wird die Mail gleich in den Postausgang gelegt
                .Send
            End With
            
            'Auf Outlook warten. Ist nicht schnell genug :-))
            Application.Wait (Now + TimeSerial(0, 0, 5)) '5 Sekunden Wartezeit
            Set Nachricht = Nothing
        Next Spalte
        Set OutApp = Nothing
    End With
End Sub


Bild

Betrifft: AW: EMail an mehrere Empfänger in Excel Liste
von: Marcel
Geschrieben am: 04.09.2015 08:54:19
Super, scheint zu funktionieren top :)
Danke Dir

 Bild

Beiträge aus den Excel-Beispielen zum Thema "EMail an mehrere Empfänger in Excel Liste"