Hallo,
ich habe durch den unten beigefügten Code versucht eine E-Mail samt Signatur automatisch kommen zu lassen. Nun habe ich das Problem, dass die Absätze in der Mail weg sind und alles in einer Zeile ist. Wie behebe ich das?
Private Sub CommandButton2_Click()
Dim objOutlook As Object
Dim objMail As Object
Dim S As String
Dim body As String
Dim htbody As String
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
If TextBox2.text = "" Or TextBox2.text = TextBox1.text Then
body = "Sehr geehrte Frau x," & vbCrLf & _
vbCrLf & _
"Folgende/r Mitarbeiter/in ist erkrankt:" & vbCrLf & _
vbCrLf & _
ComboBox1.text & vbCrLf & _
vbCrLf & _
"Zeitraum: " + TextBox1.text
Else
body = "Sehr geehrte Frau x," & vbCrLf & _
vbCrLf & _
"Folgender Mitarbeiter ist erkrankt:" & vbCrLf & _
vbCrLf & _
ComboBox1.text & vbCrLf & _
vbCrLf & _
"Zeitraum: " + TextBox1.text + " bis " + TextBox2.text
End If
htbody = fnConvert2HTML(htbody)
S = Environ("appdata") & "\Microsoft\Signatures\autoE-Mailsenden.htm"
If Dir(S, vbDirectory) <> vbNullString Then
S = S
S = CreateObject("Scripting.FileSystemObject").GetFile(S).OpenAsTextStream(1, -2).readall
With objMail
.To = "x.de"
.Subject = "Krankmeldung " + ComboBox1.text + " x"
htbody = body & "<br><br>" & S
.htmlbody = "<font face=""Arial"">" & htbody & "</font>"
.Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend manuell vom User!
End With
Else
' With objMail
' .To = Empfänger
' .Subject = Betreff
'
'
' htbody = body '& "<br><br>" & S
' .htmlbody = "<font face=""Arial"">" & htbody & "</font>"
' .Display
'
'
' ' .Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend manuell vom User!
' End With
End If
End Sub
Zudem noch folgende Funktion:
Function fnConvert2HTML(myText As String) As String
Dim bldTagOn, itlTagOn, ulnTagOn, colTagOn As Boolean
Dim i, chrCount, n As Integer
Dim chrCol, chrLastCol, htmlTxt As String
Dim myChar As String
bldTagOn = False
itlTagOn = False
ulnTagOn = False
colTagOn = False
chrCol = "NONE"
htmlTxt = "<html>"
chrCount = Len(myText)
End Function
Danke im voraus!!!
