Code anpassen für serien E-Mail

Hallo liebe Profis,
Ich hoffe jemand kann mir wahrscheinlich bei einem harmlosen Problem helfen.
Habe schon einiges ausprobiert, komme aber nicht voran.
Möchte gerne ein einzelnes Tabellenblatt "Tabelle2" aus eine "Übersicht-Mappe".xlsm
per Mail an mehreren Empfänger verschicken.
In Forum von Peter H. fand ich diesen Code"Excel_Sheet_via_Outlook_Senden".
Es funktioniert nur für einen Empfänger "irgendwer@Irgenwo.de" wunderbar.
Wie kann man den Code "Excel_Sheet_via_Outlook_Senden" umbauen daß
die "Tabelle2" an mehreren Empfänger gesendet wird?
Verschiedene E-Mails Empfäner sind in gleiche Mappe in Tabelle1 "F2:F38" eingentragen worden.


Sub Excel_Sheet_via_Outlook_Senden()
Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim AWS As String
SavePath = "D:" '"E:\Eigene Dateien"
'Kopiert aktuelles Sheet in eine neue Mappe
'welche nur diese Tabelle enthält
ActiveSheet.Copy
'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel
ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & "_" & Format(Now, "ddmmyyyy_hhmm") _
_
_
_
& ".xls"
'Mappenname wird an Variable übergeben
'und anschliessend gleich geschlossen
With ActiveWorkbook
AWS = .FullName
.Close
End With
'InitializeOutlook = True
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "irgendwer@Irgenwo.de"
.Subject = "Testmeldung von Excel2000 " & Date & Time
'Hier wird die temporär gespeicherte Datei als
'Attachment zugefügt
.Attachments.Add AWS
'Hier wird eine normale Text Mail erstellt
'.body = "Das ist ein Test" & vbCrLf & "Bitte ignorieren"
'Hier wird die HTML Mail erstellt
.HTMLBody = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'.Send
'Hier wird die temporäre Datei wieder gelöscht
Kill AWS
End With
MyOutApp.Quit
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub

Diese Code "aktive_Datei_per_Mail_versenden" sendet die komplette "Übersicht-Mappe".xlsm.
Da ich nur die "Tabelle2" senden möchte probierte ich aus beiden Code einen zu machen der mir die
Empfäger von Tabelle1 (F2:F38) ins "Bcc" rein schreibt.
Leider ohne Erfolg.


Sub aktive_Datei_per_Mail_versenden()
Dim outObj As Object
Dim Mail As Object
Dim an As String, bcc As String
an = Range("F5") & ";" & Range("F6")
bcc = Range("F7") & ";" & Range("F8") & ";" & Range("F9") & ";" & Range("F10")
ActiveWorkbook.Save
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
With Mail
.Subject = "Betreff"
.Body = "Text"
.To = an
.bcc = bcc
.Attachments.Add ThisWorkbook.FullName
End With
Mail.Display
Set Mail = Nothing
Set outObj = Nothing
End Sub

Leider habe ich nicht so viel Ahnung über VBA vielleicht kann mir jemand weiter helfen.
Vielen Dank für kommende Hilfe.
Gruß Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub aktive_Datei_per_Mail_versenden() Dim outObj As Object Dim Mail As Object Dim an As String, cc As String an = Range("F5") & ";" & Range("F6") cc = Range("F7") & ";" & Range("F8") & ";" & Range("F9") & ";" & Range("F10") ActiveWorkbook.Save Set outObj = CreateObject("Outlook.Application") Set Mail = outObj.CreateItem(0) With Mail .Subject = "Betreff" .Body = "Text" .To = an .cc = cc .Attachments.Add ThisWorkbook.FullName End With Mail.Display Set Mail = Nothing Set outObj = Nothing End Sub

Sub Excel_Serial_Mail() Dim MyOutApp As Object, MyMessage As Object Dim i As Long 'Start der Sendeschleife an 10 Empfänger For i = 1 To 10 Set MyOutApp = CreateObject("Outlook.Application") Set MyMessage = MyOutApp.CreateItem(0) With MyMessage 'Die Empfänger stehen in Spalte A ab Zeile 1 .To = Cells(i, 1) 'E-Mail Adresse 'Der Betreff in Spalte B .Subject = "Darum geht es" '"Betreffzeile" 'Der zu sendende Text in Spalte C 'Maximal 1024 Zeichen 'Der Text wird ohne Formatierung übernommen .Body = "Der Text der für alle angezeigt werden soll" & vbCrLf & _ "mit einer neuen Zeile" 'Hier wird die Mail angezeigt '.Display 'Hier wird die Mail gleich in den Postausgang gelegt .Send End With 'Objectvariablen leeren Set MyOutApp = Nothing 'CreateObject("Outlook.Application") Set MyMessage = Nothing 'MyOutApp.CreateItem(0) 'Sendepause einschalten 'Outlook kann die Aufträge nicht schnell genug verarbeiten Application.Wait (Now + TimeValue("0:00:05")) Next i End Sub

Hallo Reiner,
jetzt habe ich mein Fehler endeckt in "A1" darf kein "Empfänger" stehen sondern nur E-Mail.
Ausßerdem der Code sendet nur die E-Mails.
Ich möchte gerne aus eine Mappe nur ein Tabellenblatt ("Tabelle2") an mehreren Empfänger als Anhang senden.
Daher habe ich es mir so vorgestellt in Tabelle1 trage ich die Empfänger E-Mails ab "A1" bis "A40" und per Makro aus Excel, dachte ich es mir, Tabelle2 als Anhang an mehreren Empfänger zu schicken.
Der Macro soll die Empfänger aus Tabelle1 ab "a1" auslesen und nur die "Tabelle2" als Anhang an mehreren Empfäger weiter senden.
Daher waren meine Versuche ohne größeren Erfolge und die 2 Macros die ich am Anfang angsprochen haben einer sendet die komplette Mappe und der andere nur die E-Mails.
Hier wurde mir sehr oft geholfen daher hoffe ich auf den richtigen Hinweis.
Vielen Dank für Deine Mühe
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread