Serientermin im Outlook über Excel

Hallo Zusammen,
ich habe ein Problem und das Internet hat einfach keine Antwort für mich parat...
Ich habe eine Excel Tabelle in der in Spalten E-Mail Adressen untereinander stehen. Die Adressen in einer Spalte bilden dann jeweils einen Verteiler.
Hier ist mal eine Beispiel-Datei um das Prinzip deutlich zu machen
https://www.herber.de/bbs/user/85925.xlsx
Unter allen Spalten/ Verteilern steht ein Feld wo ein Betreff eingetragen werden soll und auch ein Text der alles betrifft (ist für alle in einem Verteiler gleich). Das soll sozusagen ein Serientermin werden.
Ich möchte jetzt einen Button unter dem Verteiler haben der mir im Outlook einen Termin öffnet und den darüber stehenden Verteiler bereits eingefügt hat und auch den Betreff und Text. Absolutes Highlight wäre dann noch das anhängen einer Datei.
Eine andere Möglichkeit wäre auch das der Button gleich automatisch an diesen Verteiler Betreff, Text und Datei verschickt.
Eine weitere Möglichkeit die akzeptabel wäre, ist das Outlook sich als Termin öffnet und Text und Betreff bereits übernommen wurden. Die Datei könnte man ja dann per Drag&Drop einfügen, genauso wie Ort und Zeit der Besprechung...
bisher stand hinter den Button´s folgender Text:

Sub Excel_Serial_Mail()
Dim MyOutApp As Object, MyMessage As Object
Dim i As Long
'Start der Sendeschleife an 10 Empfänger
For i = 6 To 43
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, 5) 'E-Mail Adresse
'Der Betreff in Spalte B
.Subject = Cells([47], [3])   '"Betreffzeile"
'Der zu sendende Text in Spalte C
'Maximal 1024 Zeichen
'Der Text wird ohne Formatierung übernommen
.Body = Cells([50], [3])
'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

Hat super funktioniert aber eben nur als Serienmail! Vielleicht reicht eine simple Umformung um mein Problem zu lösen?
Danke schon mal für Eure Hilfe
LG Hans

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Excel_Serial_Mail() Dim MyOutApp As Object, MyMessage As Object Dim i As Long Set MyOutApp = CreateObject("Outlook.Application") Set MyMessage = MyOutApp.CreateItem(0) With MyMessage 'Die Empfänger stehen in Spalte A ab Zeile 1 'Start der Sendeschleife an 10 Empfänger For i = 6 To 43 .To = Cells(i, 5) 'E-Mail Adresse Next i 'Der Betreff in Spalte B .Subject = Cells([47], [3]) '"Betreffzeile" 'Der zu sendende Text in Spalte C 'Maximal 1024 Zeichen 'Der Text wird ohne Formatierung übernommen .Body = Cells([50], [3]) '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")) End Sub

Sub Excel_Serial_Mail() Dim MyOutApp As Object, MyMessage As Object Dim i As Long Set MyOutApp = CreateObject("Outlook.Application") Set MyMessage = MyOutApp.CreateItem(0) With MyMessage 'Die Empfänger stehen in Spalte A ab Zeile 1 'Start der Sendeschleife an 10 Empfänger For i = 6 To 18 .To = .To & Cells(i, 5) 'E-Mail Adresse & ";" .To = Left(.To, Len(.To) - 1) Next i 'Der Betreff in Spalte B .Subject = Cells([47], [3]) '"Betreffzeile" 'Der zu sendende Text in Spalte C 'Maximal 1024 Zeichen 'Der Text wird ohne Formatierung übernommen .Body = Cells([50], [3]) '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")) End Sub

Hi Hans
Ja, entschuldige bitte, natürlich hattest du gleich zu Beginn ne Bsp-Datei gezeigt.
Hier nun meine Datei, die mit Klick auf den linken Button genau das macht, was sie soll.
Es wird eine Mail erzeugt mit vielen Adresseinträgen im AN-Feld - alle Adressen durch ; getrennt:
https://www.herber.de/bbs/user/86163.xlsm
(mit Makro - weiß nicht, was du falsch machtest, als es bei dir mit Makro nicht klappte)
Der Grund für den Fehler "Outlook kennt mindestens einen Namen nicht" ist, dass in deiner Adresse für Mailadressen gar keine Mailadressen drin stehen!´
Ich war mal so frei und hab überall bsp@bsp.com eingetragen.
Für den Code bedeutet das also, dass in jeder abgefragten Zelle eine Mailadresse mit gültiger Synrax stehen muss - oder - du müsstest im Code erst prüfen, ob ein Eintrag als gültige Mailaddy durchgeht.
Hilfts?
Ciao
Thorsten

Sub Excel_Control_Termin_nach_Outlook() 'E 2000 'Dim OutApp As Outlook.Application Dim OutApp As Object, apptOutApp As Object 'Hier beginnen die Termine Range("A2").Select Do Until ActiveCell.Value = "" Set OutApp = CreateObject("Outlook.Application") Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem) With apptOutApp 'Datum und Uhrzeit 'Hier werden zum aktuellen Tag 7 Tage addiert .Start = Format(Now()+7, "dd.mm.yyyy") & " 08:00" 'Alternativ werden die Termine aus der Zelle genommen '.Start = Format(ActiveCell.Value, "dd.mm.yyyy") & " 08:00" 'Dauer. Angabe ist jeweils in ganzen Minuten zu setzen 'Termininfo .Subject = "Rechnung: " & ActiveWorkbook.Name & " kontrollieren" 'oder der Betreff steht in der Spalte rechts von den Terminen .Subject = ActiveCell.Offset(0,1) 'Zusätzlicher Text .Body = "" 'ort .Location = "" .Duration = "5" 'Erinnerung .ReminderMinutesBeforeStart = 10 'mit Sound :-) .ReminderPlaySound = True 'Erinnerung wiederholen .ReminderSet = True 'Termin speichern .Save End With 'Nächste Zelle auswählen ActiveCell.Offset(1, 0).Select 'Variablen leeren,... sonst "kotzt" Outlook irgendwann mal Set apptOutApp = Nothing Set OutApp = Nothing Loop MsgBox "Termine an Outlook übertragen!" End Sub Auch das mit dem Verteiler wie er bei deiner letzten Version war...?

Beliebteste Forumthreads (12 Monate)

Serientermin im Outlook über Excel

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread