Thema: Mails in Outlook aus Excel-Daten erzeugen

Hallo zusammen,

ich habe folgendes Problem:

Ich möchte aus dieser Beispieldatei:
https://www.herber.de/bbs/user/178150.xlsx
Mails per Makro generieren lassen:
_________________________________________________________________________________________

_________________________________________________________________________________________
_________________________________________________________________________________________

_________________________________________________________________________________________

Dabei sollen in jeder Mail der Adressat (Spalte A), CC (Spalte B), Betreff (Spalte D), Anrede (Spalte C, Text (Spalte E) sowie die Informationen aus den Spalten F bis G mit Überschrift und den zur jeweiligen Mailadresse zugehörigen Zeilen eingefügt werden.
Das versenden der Mail soll jedoch nicht erfolgen.

Vielen Dank für Eure Unterstützung

Moin,

a) ich hab dein/e Anliegen/Frage verstanden.
Aber zumindest ich hab keine Lust, deine datei erst mal nachbauen zu müssen, damit ich erst dann mit testen beginnen kann.

b) daher denk ich mal, mehr Hilfe (vllt nicht nur von mir) könntest du erhalten, wenn du nich nur Bilder, sondern bitte per Upload (d)eine Excel-Bsp-Datei mit genügend Bsp-Daten in den richtigen Zellen zeigst.

Ciao
Thorsten

uih uih

Hi Andi,

ganz doll Entschuldigung!

Wer (alles) lesen kann (ich heute wohl nich^^) ist klar im Vorteil!

Ciao
Thorsten

Hallo,

eine Möglichkeit zur Abwechslung mal via Early Binding:

Option Explicit



' Beispiel mit Early Binding

' Verweis Microsoft Outlook 16.0 Library muss aktiviert sein (in diesem Beispiel bereit aktiviert)



Sub TestMail()

    Dim Outobj As Outlook.Application

    Dim Mail As Object

    Dim arrAdr(): arrAdr = Tabelle1.UsedRange.Value

    Dim i&

    Set Outobj = New Outlook.Application

    

    For i = LBound(arrAdr) + 1 To UBound(arrAdr)

        With Outobj.CreateItem(0)

            .GetInspector.Display ' öffnet den erzeugten Item

            .To = arrAdr(i, 1)

            .CC = arrAdr(i, 2)

            .Subject = arrAdr(i, 4)

            .htmlBody = "Hallo! " & arrAdr(i, 3) & "

" & arrAdr(i, 5) & "

" & TableHTMLtoBody(Tabelle1.Range("rng_Info")) & "

Mit freundlichen Grüßen
Dein Name

"

            '.Send

        End With

    Next i

    Set Outobj = Nothing

End Sub



Function TableHTMLtoBody(xlRange As Range) As String

    Dim i&, j&, htmlBody$, Zelle$

    htmlBody = ""

    '  Überschriften (ggf. anpassen)

    For i = 1 To xlRange.Columns.Count

        htmlBody = htmlBody & ""

    Next i

    ' Datenzellen

    htmlBody = htmlBody & ""

    For i = 2 To xlRange.Rows.Count

        htmlBody = htmlBody & ""

        For j = 1 To xlRange.Columns.Count

            Zelle = xlRange.Cells(i, j).Value

            If IsEmpty(Zelle) Then

                Zelle = " "

            End If

            htmlBody = htmlBody & ""

        Next j

        htmlBody = htmlBody & ""

    Next i

    htmlBody = htmlBody & "
" & xlRange.Cells(1, i).Value & "
" & Zelle & "
"

    TableHTMLtoBody = htmlBody

End Function

Ich habe dir mal noch den Abgesang unten ans Mail angehängt. Wenn das alles so passt aktivierst du dann .Send (ist schon auskommentiert vorhanden)

Gruß Uwe

sorry, da braucht es doch vielleicht noch eine kleine Erklärung:
du markierst den Bereich der Tabelle, welche in den Mail-Body soll im Tabellenblatt und verpasst diesen Bereich den Namen: rng_Info
Somit wird dieser Bereich der Funktion zum Erzeugen des HTHL Codes übergeben.

Hier mal noch besser die Datei mit angehängt.
https://www.herber.de/bbs/user/178155.xlsm

Gruß Uwe

Hallo Uwe,

leider entspricht es noch nicht ganz dem gewünschten Ergebnis. Der Makro erstellt aktuell 5 Mails (für jede Zeile 1 Mail).
In jeder Mail erscheint aktuell auch nur der Wert aus der Zelle H3 (den Bereich F1:H6 habe ich als rng_Info benannt).



Ich würde mir wünschen, dass nur 2 Mails erstellt werden - eine an Adressat1@outlook.de und eine an Adressat2@outlook.de, wobei die 1. Mail den Bereich der Überschrift F1 bis H1 und die Zellen F2 bis H4 enthalten sollte und die 2. Mail die Überschrift F1 bis H1 und die Zellen F5 bis H6.

Geht das?

Gruß & Danke für Deine Hilfe
Andi

Hallo Andi,

Frage: Bleibt es bei nur 2 Adressen wie im Beispiel oder gibt es da eine ganze Latte weitere Adressen.

Machbar ist das sowohl als auch.

Gruß Uwe

Hallo Uwe,

das können auch ganz viele werden - also variabel, sowohl die Anzahl der Empfänger als auch die dazugehörigen Zeilen.

Gruß
Andi

Hallo,

teste mal:

Option Explicit



' Beispiel mit Early Binding

' Verweis Microsoft Outlook 16.0 Library muss aktiviert sein (im diesem Beispiel bereit aktiviert)



Sub MailVersenden()

    Dim Outobj As Outlook.Application

    Dim Mail As Object, oDic As Object

    Dim i&, j&, k&, tmp, arrAdrZ(), arrAdr()

    Set oDic = CreateObject("Scripting.Dictionary")

    Set Outobj = New Outlook.Application

    With Tabelle1

        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row

            oDic(.Cells(i, 1).Value) = 0

        Next

        tmp = oDic.keys

        ReDim arrAdrZ(1 To oDic.Count, 1 To 3)

        ReDim arrAdr(1 To oDic.Count, 1 To 5)

        For i = LBound(tmp) To UBound(tmp)

            If i < UBound(tmp) Then

                arrAdrZ(i + 1, 1) = tmp(i)

                arrAdrZ(i + 1, 2) = Application.Match(tmp(i), .Columns(1), 0)

                arrAdrZ(i + 1, 3) = Application.Match(tmp(i + 1), .Columns(1), 0) - 1

            Else

                arrAdrZ(i + 1, 1) = tmp(i)

                arrAdrZ(i + 1, 2) = Application.Match(tmp(i), .Columns(1), 0)

                arrAdrZ(i + 1, 3) = .Cells(Rows.Count, 1).End(xlUp).Row

            End If

        Next i

        For i = 1 To UBound(arrAdr)

            With Outobj.CreateItem(0)

                .GetInspector.Display ' öffnet den erzeugten Item

                .To = arrAdrZ(i, 1)

                .CC = Tabelle1.Cells(arrAdrZ(i, 2), 2).Value

                .Subject = Tabelle1.Cells(arrAdrZ(i, 2), 4)

                .htmlBody = "Hallo! " & Tabelle1.Cells(arrAdrZ(i, 2), 3) & "

" & Tabelle1.Cells(arrAdrZ(i, 2), 5) & "

" & _

                TableHTMLtoBody(Tabelle1.Range("F1:H1"), Tabelle1.Range("F" & arrAdrZ(i, 2) & ":H" & arrAdrZ(i, 3))) & "

Mit freundlichen Grüßen
Dein Name

"

                '.Send

            End With

        Next i

    End With

    Set Outobj = Nothing

End Sub





Function TableHTMLtoBody(xlRangeK As Range, xlRange As Range) As String

    Dim i&, j&, htmlBody$, Zelle$

    htmlBody = ""

    '  Überschriften (ggf. anpassen)

    For i = 1 To xlRange.Columns.Count

        htmlBody = htmlBody & ""

    Next i

    ' Datenzellen

    htmlBody = htmlBody & ""

    For i = 1 To xlRange.Rows.Count

        htmlBody = htmlBody & ""

        For j = 1 To xlRange.Columns.Count

            Zelle = xlRange.Cells(i, j).Value

            If IsEmpty(Zelle) Then

                Zelle = " "

            End If

            htmlBody = htmlBody & ""

        Next j

        htmlBody = htmlBody & ""

    Next i

    htmlBody = htmlBody & "
" & xlRangeK.Cells(1, i).Value & "
" & Zelle & "
"

    TableHTMLtoBody = htmlBody

End Function

Ich hoffe, dass ich es jetzt dein Ansinnen verstanden habe.

Gruß Uwe

Hallo Uwe,

wir kommen der Sache näher. Jetzt werden nur noch 2 Mails erzeugt, was hier passen würde.

Allerdings wird nicht der gewünschte Bereich eingefügt. Im Beispiel Max Mustermann sieht das so aus:


Statt Testinfo3-3 sollte nach Möglichkeit in neuen Zeilen erscheinen:


Habe versucht einen Zeilenumbruch mit dem Befehl vbLf einzufügen, hat aber nicht zum gewünschten Ergebnis geführt....

Gruß
Andi

Hallo,

Ich war davon ausgegangen, dass zum jeweiligen Adressaten die entsprechenden Einträge in der Tabelle passend zugeordnet sind um diese dann in den Body der Mails zu übergeben.

Eine ordentliche Tabelle enthält, um dies vernünftig auswerten zu können, in jeder Zeile stets einen kompletten Datensatz. Wie soll ein Automatismus erkennen, dass der letzte Datensatz in der letzten Zeile des Adressaten1 bereits dem Adressaten2 zugeordnet werden soll?

Überdenke bitte deinen Tabellenaufbau und lade diesen nebst entsprechend auswertbarer Kennzeichnung der neuen Einträge, welche Teile der Tabelle ins jeweilige Mail sollen hier hoch.

Dann wird es auch eine dynamisch funktionierende Lösung dazu geben mit der du keine Probleme hast.

Gruß Uwe

Hallo Uwe,

um meine Vorstellung zu veranschaulichen anbei die Mails, wie ich sie mir wünschen würde:
___________________________________________________________________________________

___________________________________________________________________________________


___________________________________________________________________________________

Es sollen also auch pro Mailadresse aus Spalte A die Überschriften aus Spalte F bis H und die zugehörigen Informationen aus den Spalten F bis H in der Mail ausgegeben werden.

Geht das?

Viele Grüße
Andi

Hallo Andi,

das prinzipielle Format wie in deinem Beispiel wird doch so erzeugt.
Lediglich das Ausrufezeichen nach Hallo und der Fette Text <b> bis </b> muss durch Entfernen von <b> und </b> geändert werden.
Der Inhalt der Tabelle ist korrekt. Einzig die Spaltenbreite ist automatisch.
geänderter Code:

Option Explicit



' Beispiel mit Early Binding

' Verweis Microsoft Outlook 16.0 Library muss aktiviert sein (im diesem Beispiel bereit aktiviert)



Sub MailVersenden()

    Dim Outobj As Outlook.Application

    Dim Mail As Object, oDic As Object

    Dim i&, j&, k&, tmp, arrAdrZ(), arrAdr()

    Set oDic = CreateObject("Scripting.Dictionary")

    Set Outobj = New Outlook.Application

    With Tabelle1

        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row

            oDic(.Cells(i, 1).Value) = 0

        Next

        tmp = oDic.keys

        ReDim arrAdrZ(1 To oDic.Count, 1 To 3)

        ReDim arrAdr(1 To oDic.Count, 1 To 5)

        For i = LBound(tmp) To UBound(tmp)

            If i < UBound(tmp) Then

                arrAdrZ(i + 1, 1) = tmp(i)

                arrAdrZ(i + 1, 2) = Application.Match(tmp(i), .Columns(1), 0)

                arrAdrZ(i + 1, 3) = Application.Match(tmp(i + 1), .Columns(1), 0) - 1

            Else

                arrAdrZ(i + 1, 1) = tmp(i)

                arrAdrZ(i + 1, 2) = Application.Match(tmp(i), .Columns(1), 0)

                arrAdrZ(i + 1, 3) = .Cells(Rows.Count, 1).End(xlUp).Row

            End If

        Next i

        For i = 1 To UBound(arrAdr)

            With Outobj.CreateItem(0)

                .GetInspector.Display ' öffnet den erzeugten Item

                .To = arrAdrZ(i, 1)

                .CC = Tabelle1.Cells(arrAdrZ(i, 2), 2).Value

                .Subject = Tabelle1.Cells(arrAdrZ(i, 2), 4)

                .htmlBody = "<html>Hallo " & Tabelle1.Cells(arrAdrZ(i, 2), 3) & ",<br><br>" & Tabelle1.Cells(arrAdrZ(i, 2), 5) & "<br><br>" & _

                TableHTMLtoBody(Tabelle1.Range("F1:H1"), Tabelle1.Range("F" & arrAdrZ(i, 2) & ":H" & arrAdrZ(i, 3))) & "<br><br>Mit freundlichen Grüßen<br>Dein Name<br><br></html>"

                '.Send

            End With

        Next i

    End With

    Set Outobj = Nothing

End Sub





Function TableHTMLtoBody(xlRangeK As Range, xlRange As Range) As String

    Dim i&, j&, htmlBody$, Zelle$

    htmlBody = "<TABLE border=0>"

    '  Überschriften (ggf. anpassen)

    For i = 1 To xlRange.Columns.Count

        htmlBody = htmlBody & "<TH bgcolor=a8a8a8>" & xlRangeK.Cells(1, i).Value & "</TH>"

    Next i

    ' Datenzellen

    htmlBody = htmlBody & "</TR>"

    For i = 1 To xlRange.Rows.Count

        htmlBody = htmlBody & "<TR>"

        For j = 1 To xlRange.Columns.Count

            Zelle = xlRange.Cells(i, j).Value

            If IsEmpty(Zelle) Then

                Zelle = " "

            End If

            htmlBody = htmlBody & "<TD>" & Zelle & "</TD>"

        Next j

        htmlBody = htmlBody & "</TR>"

    Next i

    htmlBody = htmlBody & "</TABLE>"

    TableHTMLtoBody = htmlBody

End Function

So sehen die Ausgaben in Outlook aus:



Ich hoffe, dass ich alles zu maskierenden Zeichen für diesen Code Tag soweit erforderlich erwischt habe. Vorsorglich noch die Testdatei anbei.
https://www.herber.de/bbs/user/178243.xlsm

Gruß Uwe

Hallo Andi,

zu Erklärung:
<<<Habe versucht einen Zeilenumbruch mit dem Befehl vbLf einzufügen, hat aber nicht zum gewünschten Ergebnis geführt....>>>

Bei einer HTML-Mail werden diese Steuerzeichen ignoriert. Hier musst Du einen HTML-Umbruch einsetzen: <br>

Gruß
Karl-Heinz

Hallo Thorsten,

alles gut - kann mal passieren.

Gruß
Andi

Moin,

@Thorsten: die Datei ist drin. Aber bei dir der Kaffee wohl noch nicht ;-)

@Andi: es hört sich mehr wie eine Beauftragung als eine Hilfe oder Unterstützung an.

Für solche Mails gibt es den Seriendruck in Word. Es ist extra dafür gemacht. "Briefe" können als Mail versendet oder als PDF und dann in einer Mail versendet. Excel ist an der Stelle nicht der passende Werkzeug.

VG
Yal

Hallo Thorsten,

die Datei wurde von mir mit eingefügt (Hast Du wahrscheinlich wegen der eingefügten Bilder der Mails nicht wahrgenommen).

https://www.herber.de/bbs/user/178150.xlsx

Lediglich die Mails sind als Bilder eingefügt um besser darzustellen, wie meine Vorstellungen wären.
Ob das so gemacht werden kann, vermag ich nicht zu beurteilen. Dazu fehlen mir einfach die Kenntnisse und deshalb
meine Frage bzw. Bitte um Hilfe.

Viele Grüße
Andi