VBA zu HTML Code umgewandelt - Zeilenumbrüche weg?
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!!!
3 Antworten
Das ganze geht auch mit ShellExecute aus meiner Sicht etwas einfacher:
Public Sub mySendMail(ByVal Address As String, _
ByVal Subject As String, ByVal body As String, _
ByVal CC As String, ByVal BCC As String)
Dim strCommand As String
strCommand = ""
If Len(Subject) Then strCommand = "&Subject=" & Subject
If Len(body) Then strCommand = strCommand & "&Body=" & body
If Len(CC) Then strCommand = strCommand & "&CC=" & CC
If Len(BCC) Then strCommand = strCommand & "&BCC=" & BCC
'strCommand = strCommand & "&attach=" & """" & "c:\temp.txt" & """"
If Len(strCommand) Then
mailto:rCommand, 1, 1) = "?"
End If
strCommailto:"mailto:" & Address & strCommand
Call ShellExecute(0&, "Open", strCommand, "", "", 1)
End Sub
Du wandelst die Textmail in eine HTML-Mail um. In HTML werden Umbrüche als <br /> dargestellt. Die vbCrLf werden von HTML als Umbrüche ignoriert.
Du musst das schon als Zeichenkette verwenden. Du kannst dir ja eine eigene Konstante definieren.
Const htmlCrLf As String = "<br />"
Vielen Dank. Ich weiß nicht warum man einen unerfahrenen Azubi auf so ein komplexes Thema schiebt :D
diese zeichen bei
body = "Sehr geehrte Frau x," & vbCrLf & _
musst du umwandeln lassen , vielleicht einfacher eine 2 funktion zu schreiben die nur den inhalt wandelt in <br> bzw auch umlaute etc . die convert funktion ist irgendwie eh nicht vollständig .
Dann wird mir dort aber ein Syntaxfehler angezeigt :/