Ich habe ein großes Problem: Ich habe eine Excel Datei mit einem Formular, um aus der Datei heraus eine Mail zu erstellen. Das funktioniert auch, aber leider bekomme ich den Zeilenumbruch, der im Textfeld meines Formulars (bei Absätzen und Leerzeilen) erscheint, nicht in die Outlook Mail. Ebenso schaffe ich es nicht, die Datei an die zu erstellende Mail anzuhängen. Die Empfänger, der Betreff werden aus dem Formular übernommen, auch klappt die restliche Prozedur (Formular schließen, Outlook Mail-Fenster mit neuer Nachricht öffnen) problemlos. Wir arbeiten mit Office 2013 und haben so ziemlich alle Erweiterungen, die man bekommen kann.
Bei der Datei handelt es sich um eine Fehlerliste, die ich bei Bedarf an die Mail anhängen möchte. In der Excel-Datei sind die Daten für den Kundendienst und eine kleine Liste von möglichen Empfängern hinterlegt. Die Funktion, eine Mail aus der Datei (mit oder ohne die Datei im Anhang)zu verschicken, würde mir einiges an Arbeit und das Hin- und Herspringen zwischen Excel und Outlook sparen.
Vielleicht weiß jemand Rat. Vielen Dank!
Private Sub MailInOutlookOeffnen_click()
On Error Resume Next
Dim EmailEmpfänger As String
Dim CCEmailEmpfänger As String
Dim olApp As Object
EmailEmpfänger = EmailEmpfängerComboBox.Text
Kopie = CCEmailEmpfängerComboBox.Text & ";" & CCEmailEmpfängerComboBox2.Text & ";" & _
CCEmailEmpfängerComboBox3.Text
Emailtext = Emailtext.Text
On Error Resume Next
Dim rng As Range
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.GetInspector.Display
olOldBody = .htmlbody
Set rng = Selection
.To = EmailEmpfänger
.CC = Kopie
.Subject = Betreff.Text
Set .SendUsingAccount = .Session.Accounts.Item("Kontoname")
.htmlbody = Emailtext & olOldBody
If CheckBox1Lesebestätigung.Value = True Then .ReadReceiptRequested = True
If CheckBox1Lesebestätigung.Value = False Then .ReadReceiptRequested = False
If CheckBox3Anhang.Value = True Then .Attachments.Add ActiveWorkbook.FullName = True
.Display
If CheckBox2EmailSofortVersenden.Value = True Then SendKeys "%s", True
End With
Set rng = Nothing
Set olApp = Nothing
Unload Me
End Sub