Mail mit Makro versenden
25.11.2022 11:44:15
Christian
ich bin Gelegenheitsprogrammierer und baue mir für die Arbeit meine Listen selber zusammen.
Derzeit erweitere ich eine Liste in der Command Buttons Aktionen auslösen oder weitere Tabellen öffnen.
Ich nutze einen Knopf, um Informationen aus bestimmten Zellen in eine Mail zu kopieren, und diese dann an festgelegt Verteiler zu senden.
Das klappt einwandfrei. Doch leider gibt es zwei Rechner, welche kein Outlook installiert haben.
Und damit habe ich ein Problem.
Rechner 1 öffnet Outlook in Chrome.
Rechner 2 benutzt das Programm Mail.
Ich habe schon recherchiert, bin dabei aber nicht weiter gekommen, da es anscheinend sehr viele Ausnahmen und Möglichkeiten gibt.
Hier mein derzeitiger Code.
Private Sub CommandButton1_Click()
' Sendet Mail mit integriertem Bereich als Bereich mit Signatur
Dim WSh As Worksheet
Dim sMailtext As String
Dim sBer As String
sBer = "A4:B13" ' Kopierbereich
Set WSh = ThisWorkbook.Sheets("Tabelle 1") ' Blatt mit Maildaten
WSh.Range(sBer).Copy ' Bereich kopieren
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2 ' 2=HTML-Format, 3=Richtext
.Subject = "Themen der Woche" ' Betreff
.to = "Mailadresse@...": ' Empfänger
.Cc = "Mailadresse@.." ' Empfänger CC
sMailtext = "Hallo zusammen, ¶hier die Themen :¶¶" ' Mailbodytext
sMailtext = Replace(sMailtext, "¶", vbLf) ' Umbrüche einfügen
.GetInspector ' Signatur holen
.htmlbody = Replace(sMailtext, vbLf, "
") & .htmlbody
.Display
With .GetInspector.WordEditor.Application.Selection
.Start = Len(sMailtext): .Paste ' Grafik in Mail einfügen
End With
End With
End Sub
Beste Grüße
Christian