Outlook E-Mail aus Excel Verteilerliste senden
Ausgangslage - Was tut dieser Code-Schnipsel?
Folgende Situation: Sie haben eine Abteilungstabelle und möchten gerne alle
Mitarbeiter einer Abteilung per E-Mail anschreiben.
Zur Verdeutlichung einmal die Tabelle1 (Mitarbeiterliste mit E-Mails und Abteilung).
| A | B | C | D | E | |
|---|---|---|---|---|---|
| 1 | Empfängerabteilung: | Abteilung A | |||
| 2 | |||||
| 3 | Abteilung | Name | Vorname | ||
| 4 | Abteilung A | Wershoven | Marc | info@wershovenonline.de | |
| 5 | Abteilung A | Mustermann | Max | max.m@online-vba.de | |
| 6 | Abteilung B | Beispiel | Berta | berta.b@online-vba.de | |
| 7 | Abteilung B | Herzlich | Hugo | hugo.h@online-vba.com | |
| 8 |
Wird nun in Zelle B1 mittels der Auswahlbox oder per Hand die Abteilung A eingetragen / ausgewählt,
soll eine E-Mail an alle Mitarbeiter der Abteilung A vorbereitet werden.
Für diese Vorbereitung finden Sie folgend ein Beispielmakro.
Das Makro kann über eine Schaltfläche oder direkt mittels ALT+F8 gestartet werden.
Hier überlasse ich Ihnen die freie Wahl.
Bitte verwenden Sie die Beispieldaten nicht für Ihren Testlauf, die angegebenen E-Mail Adressen sind frei erfunden!
Ergebnisse statt Aufwand & Arbeit?
Wir liefern Ergebnisse - Schicken Sie uns kurz Ihre Datei und Ihre Wünsche; wir integrieren den notwendigen Code professionell, beheben ggf. vorhandene Fehler, machen optional ein Code-Review, liefern bei Bedarf Performance-Optimierungen & setzen gewünschte Erweiterungen effizient für Sie um (und das zum Festpreis nach kurzer Sichtung).
Express-Service beauftragen
Der Quelltext
Option Explicit
' Original-Quelltext unter: https://www.online-vba.de/outlook-e-mail-aus-excel-verteilerliste-senden
' Express-Hilfe für VBA unter https://www.online-vba.de/vba-expresshilfe
' Es gelten die Nutzungsbedingungen von Online-VBA.de
Public Sub OVBAde_AbteilungsVerteilerMailVersand()
Dim oAppOutlook As Object
Dim i As Long
Dim sAbteilung As String
Dim sTemp As String
sAbteilung = Sheets("Tabelle1").Cells(1, 2).Value
sTemp = ""
With Sheets("Tabelle1")
For i = 4 To .UsedRange.Rows.Count + .UsedRange.Row - 1
If .Cells(i, 1).Value = sAbteilung Then
sTemp = sTemp & .Cells(i, 4).Value & ";"
End If
Next i
'Das letzte Semikolon entfernen
If Trim(sTemp) <> "" Then
sTemp = Left(sTemp, Len(sTemp) - 1)
End If
End With
'Wenn mindestens eine E-Mail Adresse gefunden wurde, wird eine E-Mail vorbereitet:
If Trim(sTemp) <> "" Then
Set oAppOutlook = CreateObject("Outlook.Application")
With oAppOutlook.CreateItem(0)
.To = sTemp 'Unser E-Mail Empfänger String aus sTemp
.Subject = "Betreffzeile" 'E-Mail Betreffzeile
.Body = "Mail-Inhalt ..." 'E-Mail Inhalt
.Display 'E-Mail anzeigen
'.Send = Direkt senden
End With
Else
MsgBox "Die gesuchte Abteilung hat keine " & _
"hinterlegten Mitarbeiter oder E-Mail Adressen!"
End If
Set oAppOutlook = Nothing
End Sub
Das könnte Sie auch interessieren:
Erhöhen Sie Ihr Sicherheits- und Datenschutzniveau mit Awareness-Schulungen – kompakt, alltagsnah und nachweisbar. Wir unterstützen Sie mit einem VBA-Entwickler für Hagen – Festpreise und direkter Ansprechpartner.
Anmerkungen und Hinweise
Dieser Codeschnipsel wurde geschrieben von Marc Wershoven im Jahr 2014.
Die Nutzung erfolgt auf eigene Gefahr.
Bitte denken Sie immer zuerst an eine ausreichende Datensicherung.
Wir können keinen kostenlosen Support anbieten.
Es gelten unsere Nutzungsbedingungen.
