Mail aus Excel heraus - 4 Bereiche an 4 Empfänger

Hallo zusammen!

Ich habe schon verschiedene Beispiele hier im Forum ausprobiert, die ich entsprechend abgeändert habe.
Alles leider ohne wirklichen Erfolg.
Da ich von VBA nicht wirklich einen Plan habe und nur erfolgreich kopiere, wäre ich über etwas Hilfe äußerst dankbar.

Zu meiner Problemstellung:
Ich möchte aus einem bestimmten Sheet je eine Mail mit dem Bereich A3:L9 an Empfänger 1, Bereich A12:N32 an Empfänger 2, Bereich A35:L41 an Empfänger 3 und Bereich A52:N63 an Empfänger 4 versenden.
Ich hatte mir hier entweder ein Makro vorgestellt, dass alles in einem Schritt macht oder eines bei dem ich jedes Verschicken quasi einzeln per Button aktiviere.
Ein Makro das eine Mail öffnet hatte ich bereits erfolgreich kopiert und aus die Empfänger passend eingebaut, aber ich bekomme kein Bereich erfolgreich eingebettet, geschweige denn mehr als ein Empfänger.
Derzeit erledige ich das öffnen der Mail, einbetten des Bereiches und das Verschicken noch zu 100% manuell - würde ich gern ändern.

Kann mir hier jemand eine Vorlage erstellen die das kann?
BTW: ich nutze Excel 2016, falls das dafür wichtig ist.

Besten Dank und viele Grüße
Michael

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'Outlook VBA
dim EML as Mailitem
dim XL as object, WB as Object

Set XL = CreateObject("Excel.Application")

Set WB = XL.workbooks.Open(Pfad & "Name.xlsx")

set EML = CreateObject(mailitem)
EML.Body = "Mein Text"

WB.sheets(1).Range("A1:N92").Copy

With EML.GetInspector.WordEditor
.Content.Paragraphs.Add
.Content.Paragraphs.Add
.Range(Len(.Range.Text) - 1).Paste 'ok
end with

Code:

Sub MailErstellen()
  Dim oMail As Object, WSh As Worksheet
  Dim sBer() As String, sTo() As String, sPers() As String, sMailtext As String
  Dim i As Integer
  
  sBer = Split("A3:L9,A12:N32,A35:L41,A52:N63", ",")
  sTo = Split("Pers1@web.de,Pers2@web.de,Pers3@web.de,Pers4@web.de", ",")
  sPers = Split("Hugo,Herr Meier,Onkel Kurt,Franz", ",")
  Set WSh = ThisWorkbook.Sheets("Tabelle2")     ' Blatt ggf. anpassen

  With CreateObject("Outlook.Application")
     For i = 0 To UBound(sBer)
         Set oMail = .CreateItem(0)
         With oMail
            .BodyFormat = 2                ' HTML-Format, Angabe optional
            .To = sTo(i)                   ' Empfänger
            .Subject = "Berichtswesen"     ' Betreff
            .Getinspector.Display          ' Signatur holen
            sMailtext = "Hallo " & sPers(i) & "¶" _
                      & "hier ist der aktuelle Bericht.¶¶"
              
            .htmlbody = "<span style='font-family:Arial;font-size:10pt; color:#000000;'>" _
                      & Replace(sMailtext, "¶", "<br>") & "</span>" & .htmlbody
             
            WSh.Range(sBer(i)).Copy        ' Bereich kopieren
            With .Getinspector.WordEditor.Application.Selection
               .Start = Len(sMailtext) + 0 ' Einfügestelle (ggf. die +/-1 anpassen)
               .Paste                      ' Bereich in Mail einfügen
            End With
'            .Send
         End With
         Set oMail = Nothing
     Next i
  End With
End Sub

Hallo Michael,

der Punkt ist eben die Formatierung. Wenn Dein Empfänger auf Text statt html-Darstellung gestellt hat, fehlen z.B. selbige.
Volti's Code ist für die html-Darstellung sicher die optimalste Variante.
Ich hänge trotzdem mal eine Alternative an. Es gab und gibt immer noch MailEnvelope, wo man scheinbar direkt im Excel mailt.

In der Exceldatei könntest Du auf Tabelle1 so was eintragen

	A	B
1	irgendwer@irgendwo.de	André
2
3	A	B
4	C	D
5	E	F

Verwendete Systemkomponenten: [Windows (64-bit) NT 10.00] / MS Excel 365

und mit dem Code einen definierten Bereich senden. Der Bereich wird dazu im Code selektiert.
Kann man natürlich noch ausbauen, z.B. eine Schleife für mehrere Adressaten, die Bereiche parametrisieren, die vorherige aktive Zelle wieder aktivieren u.a.
.Send hab ich auskommentiert, damit Du Dir die Mail vor dem senden anschauen kannst. Es wird übrigens der sichtbare Bereich vom Blatt angezeigt, gesendet wird nur die Selektion.

Sub RngTo_MailEnvelope()

'Mit dem Bereich zum senden

With Worksheets("Tabelle1").Range("A3:B5")

    'zuerst Bereich auswaehlen

    .Select

    'eingebettete Mailumgebung hervorholen

    ActiveWorkbook.EnvelopeVisible = True

    'mit der Mailumgebung

    With .Parent.MailEnvelope

        '"Einleitungsext" der EMail, siehe Feld oberhalb der Tabellendarstellung.

        'Wird durch automatische Trennlinie abgehoben

        .Introduction = "Hallo" & Worksheets("Tabelle1").Range("B1").Value & vbLf & "Das ist eine Testmail."

        'Mit der EMail

        With .Item

            .To = Worksheets("Tabelle1").Range("A1").Value ' an wen

            .Subject = "Übersicht" ' Betreff

            .Display ' Mail anzeigen - zum senden

            '.Send 'automatisch senden - alternativ in Excel oben

        'Ende Mit der EMail

        End With

    'Ende mit der Mailumgebung

    End With

'Ende Mit dem Bereich zum senden

End With

'eingebettete Mailumgebung verbergen

ActiveWorkbook.EnvelopeVisible = False

End Sub

Beliebteste Forumthreads (12 Monate)

Mail aus Excel heraus - 4 Bereiche an 4 Empfänger

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mail aus Excel heraus - 4 Bereiche an 4 Empfänger

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread