Fenster zum Auswählen E-Mail-Empfänger
29.10.2021 08:51:20
RaMa
zu meinen Kenntnissen: ich kopiere dank diesem Forum viele Dinge & passe es an & fluche & probiere weiter & irgendwann funktioniert es :)
Ich habe ein Makro zum Erstellen einer automatische E-Mail, in der mehrere Passagen automatisch angepasst werden.
Ich habe schon im Archiv gesucht, aber ich habe keine passende Lösung gefunden oder mangels Wissen nicht die richtigen Schlagwörter genutzt.
Ist es Möglich, dass ich neben den 2 vorhanden "starren" E-Mail-Empfänger weitere variable Empfänger per Auswahlliste hinzufügen kann.
Es soll also mit dem Klick auf dem CommandButton eine Auswahlbox erscheinen, in der ca. 10 verschiedenen Personen samt E-Mail-Adresse aufgeführt sind und ich 1 oder mehrere Personen anklicken kann und diese dann den vorhandenen 2 Empfängern hinzugefügt werden.
Die Namen möchte ich auf meinen extra Reiter "Datenblatt" in freie Zellen aufführen.
Ist das möglich?
Vielen Dank für eure Hilfe.
Mein momentaner Code lautet:
Private Sub CommandButton1_Click()
'** - - - Heutiges Datum, filtern und sortieren - - -
ActiveSheet.Unprotect
Range("E3").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
ActiveSheet.Range("$A$7:$H$40").AutoFilter Field:=8, Criteria1:=""
ActiveWorkbook.Worksheets("Mengenänderungen_Info-Mail").AutoFilter.Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Mengenänderungen_Info-Mail").AutoFilter.Sort. _
SortFields.Add Key:=Range("H7:H40"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Änderungen_Info-Mail").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'** - - - Automatische E-Mail - - -
Dim xOutApp As Object
Dim xOutMail As Object
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
'** Pfad und Dateiname benennen
strDatei = "C:\Temp\Änderungen vom " & Range("E3") & ".pdf"
'** aktive Tabelle als PDF speichern
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strDatei, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
With xOutMail
.GetInspector
.To = "asdf@mail.de" & ";" & "qwert@mail.de"
.CC = ""
.BCC = ""
.Subject = "Änderungen vom " & Range("E3") & ""
.Attachments.Add strDatei
.HTMLBody = "" & _
"Hallo zusammen,
" & _
"anbei sende ich euch die Änderungen des heutigen Tages." & .HTMLBody
.Display 'or use .Send
End With
'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close
'** Erzeugte Datei wieder löschen
Kill (strDatei)
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
'** - - - Datum löschen, Zellen wieder einblenden - - -
Range("E3").Select
ActiveCell.FormulaR1C1 = ""
ActiveSheet.Range("$A$7:$H$40").AutoFilter Field:=8
ActiveSheet.Protect
End Sub
RaMa