Registriert seit: 12.10.2014
Version(en): 365 Insider (64 Bit)
Moin! .To muss bei einem Mehrfachverteiler ein semikolongetrennter Gesamtstring sein! Hier mal ein Beispielmakro: https://www.online-vba.de/vba_mailverteilerexcel.phpGruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Registriert seit: 10.04.2014
Version(en): 2016 + 365
14.12.2016, 10:29
(Dieser Beitrag wurde zuletzt bearbeitet: 14.12.2016, 10:29 von Rabe.)
Hi, bei mir funktioniert es so: Sub Mail_Workbook_Outlook_Gesamt() Dim MyOutApp As Object, MyMessage As Object Dim lngZeile As Long Dim lngSpalte As Long Dim strEmpfänger As String 'Die Empfänger stehen in Spalte B (2) bis T (20) mit 1 Spalte Abstand (Step 2) 'verkettet in eine Variable For lngSpalte = 2 To 20 Step 2 'in Zeile 3 bis 40 For lngZeile = 3 To 40 If Cells(lngZeile, lngSpalte) <> "" Then strEmpfänger = strEmpfänger & ";" & Cells(lngZeile, lngSpalte).Value End If Next lngZeile Next lngSpalte
'Mail erstellen und senden Set MyOutApp = CreateObject("Outlook.Application") Set MyMessage = MyOutApp.CreateItem(0) With MyMessage .to = strEmpfänger 'E-Mail Adressen verkettet .CC = "" .BCC = "" 'Der Betreff .Subject = "Änderung Datei" 'Der zu sendende Text, wird ohne Formatierung übernommen .Body = "Anbei die geänderte Datei," & vbCrLf & _ "wie besprochen!" 'Die angehängte Datei .Attachments.Add ActiveWorkbook.FullName 'Hier wird die Mail angezeigt .Display 'Hier wird die Mail gleich gesendet '.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
Folgende(r) 1 Nutzer sagt Danke an Rabe für diesen Beitrag:1 Nutzer sagt Danke an Rabe für diesen Beitrag 28
• nedial
Registriert seit: 13.12.2016
Version(en): 2010
Super! Vielen Dank. Es funktioniert, wenn man von dem "Verteilerlisten-Blatt" aus startet! Jetzt muss ich es nurnoch so abändern, dass ich das ganze von jedem Arbeitsblatt aus starten kann.
Mal grundsätzlich ein ganz dickes Lob an alle, die hier aktiv sind und uneigennützig weiterhelfen!!!
Grüße
Registriert seit: 12.10.2014
Version(en): 365 Insider (64 Bit)
14.12.2016, 14:49
(Dieser Beitrag wurde zuletzt bearbeitet: 14.12.2016, 14:49 von RPP63.)
Moin! Gehe mal in die VBA-Hilfe und suche nach With-Anweisung Oder per Google: http://www.herber.de/mailing/vb/html/vastmwith.htmSchließlich sollte es bei Dir Klick! machen (Hilfe zur Selbsthilfe) Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Registriert seit: 12.03.2016
Version(en): Excel 2003/ 2016
Hallo Zitat: .to = Worksheets("E-Mail-Verteilerlisten").Range("CC1") ıch habe jetzt noch nicht verstanden ob obiger Code klappt?? Wenn ja für For Nexr diese Antwort von Zwergel Zitat:Ich würde eine Variable in eine Zelle schreiben lassen und deren Wert dann im 2. Makro auslesen und verwenden. statt wie in deinem 1. Code mit Set zu arbeiten dann alle Adresse in eine Hilfsspalte laden und auslesen Zitat:Set PP10 = Range("B3:B40") Set PP12 = Range("D3:D40") B3:B40. D3:D40 usw. in eine Hilfsspalte alle untereinander schreiben und über For Next als Adresse in die Variable Adr einlesen Code: For j = 1 tp xxx With OutMail Adr = Cells(j,"A").Value .to = Worksheets("E-Mail-Verteilerlisten").Range(Adr) End With Next j
Ich weiss nicht ov es klappt, einfach ausprobieren. mfg Gast 123
Registriert seit: 12.03.2016
Version(en): Excel 2003/ 2016
Sorry ich hatte die Antworten von Rabe und RPP63 nicht gesehen. Vergiss was ich geschrieben habe! Vielleicht hift dir die zusaetzliche With Klammer weiter. Würde mich freuen. mfg Gast 123 Code: With Worksheets("Verteilerlisten-Blatt") For lngSpalte = 2 To 20 Step 2 'in Zeile 3 bis 40 For lngZeile = 3 To 40 If .Cells(lngZeile, lngSpalte) <> "" Then strEmpfänger = strEmpfänger & ";" & .Cells(lngZeile, lngSpalte).Value End If Next lngZeile Next lngSpalte End With
Registriert seit: 13.12.2016
Version(en): 2010
Ja die for next schleife funktioniert!
Das Anwählen des Arbeitsblattes per with / end with, um auch von anderen Blättern aus starten zu können, hatte ich auch so umgesetzt funktioniert bis jetzt leider noch nicht.
Noch eine optionale Frage: Welche Möglichkeit gibt es, dass der jeweilige Versender der Mail, der sich sehr oft wechselt (immer jemand, der auch auf der Verteilerliste steht) die Mail quasi nicht an sich selbst schickt?
Grüße und nochmals danke für eure Hilfe. Bin echt begeistert wie aktiv ihr hier seid!
Registriert seit: 10.04.2014
Version(en): 2016 + 365
15.12.2016, 11:28
(Dieser Beitrag wurde zuletzt bearbeitet: 15.12.2016, 11:28 von Rabe.)
Hi, (15.12.2016, 09:08)nedial schrieb: Das Anwählen des Arbeitsblattes per with / end with, um auch von anderen Blättern aus starten zu können, hatte ich auch so umgesetzt funktioniert bis jetzt leider noch nicht. bei mir geht es so: Sub Mail_Workbook_Outlook_Gesamt() Dim MyOutApp As Object, MyMessage As Object Dim lngZeile As Long Dim lngSpalte As Long Dim strEmpfänger As String 'Die Empfänger stehen in Spalte B (2) bis T (20) mit 1 Spalte Abstand (Step 2) 'verkettet in eine Variable With Sheets("E-Mail-Verteilerlisten") For lngSpalte = 2 To 20 Step 2 'in Zeile 3 bis 40 For lngZeile = 3 To 40 If .Cells(lngZeile, lngSpalte) <> "" Then strEmpfänger = strEmpfänger & ";" & .Cells(lngZeile, lngSpalte).Value End If Next lngZeile Next lngSpalte End With 'Mail erstellen und senden Set MyOutApp = CreateObject("Outlook.Application") Set MyMessage = MyOutApp.CreateItem(0) With MyMessage .To = strEmpfänger 'E-Mail Adressen verkettet .CC = "" .BCC = "" 'Der Betreff .Subject = "Änderung Datei" 'Der zu sendende Text, wird ohne Formatierung übernommen .Body = "Anbei die geänderte Datei," & vbCrLf & _ "wie besprochen!" 'Die angehängte Datei .Attachments.Add ActiveWorkbook.FullName 'Hier wird die Mail angezeigt .Display 'Hier wird die Mail gleich gesendet '.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 Zu Deiner Zusatzfrage: In irgendeiner Zelle sollte die Mail-Adresse des Absenders stehen, dann kannst Du diese mit dem Inhalt der Empfängerliste abgleichen und weglassen: If .Cells(lngZeile, lngSpalte) <> "" Or .Cells(lngZeile, lngSpalte) <> Absenderadresse Then
strEmpfänger = strEmpfänger & ";" & .Cells(lngZeile, lngSpalte).Value
End If
Registriert seit: 13.12.2016
Version(en): 2010
Bei mir funktioniert es nicht, wenn ich mit einem Button von einem anderen Worksheet aus starte.  Auch wenn ich es einfach copy & paste. Ok, das mit dem optionalen Ausschluss fällt denke ich weg. Ist auch nicht weiter tragisch, wenn der Versender, der die letzte Änderung vorgenommen hat, selbst die Datei nochmal bekommt. Ich schicke ja letztendlich alles über outlook raus. Von dort müsste es dann quasi eine Überprüfung geben, welche E-Mail-Adresse aus dem Verteiler die Datei versendet. Will dich/euch jetzt auch nicht überstrapazieren mit dem Thema.
Registriert seit: 10.04.2014
Version(en): 2016 + 365
15.12.2016, 15:00
(Dieser Beitrag wurde zuletzt bearbeitet: 15.12.2016, 15:00 von Rabe.)
Hi, (15.12.2016, 12:20)nedial schrieb: Bei mir funktioniert es nicht, wenn ich mit einem Button von einem anderen Worksheet aus starte.  Auch wenn ich es einfach copy & paste. Ich habe 2 verschiedene Makros (eines mit abteilungspezifischer Auswahl und das schon gepostete) und in zwei Tabellenblättern jeweils 2 Buttons, mit denen ich das Makro von dieser Tabelle und der anderen aufrufe. Zum Ausschlußthema: Du kannst irgendwo in eine Liste die Einlogg-Namen und die dazugehörigen Mail-Adressen schreiben und dann in einer Zelle mit SVERWEIS darauf zugreifen. Dann kannst Du diese Zelle wie oben beschrieben im Makro einbinden, das ist ganz einfach! Hier die Datei, bei der es bei mir mit beiden Makros und mit dem Ausschluß funktioniert:
MultiAreaRange-Mails.xlsb (Größe: 31,31 KB / Downloads: 4)
|