Email senden Schrift Farbe wie im Outlook
17.12.2020, 20:11
(Dieser Beitrag wurde zuletzt bearbeitet: 17.12.2020, 20:12 von schwarzeteufel.)
Ich habe eine Tabelle und in der Tabelle habe ich eine Code das E-Mail gesendet wird. das funktioniert auch.
Meine Frage ist kann man das so umändern das die Signierung wie im Outlook die Schrift und Farbe übernimmt.
Im Outlook ist bei mir die was im .Body steht
"Sehr geehrte Damen und Herren." und "Anbei die Excel Liste als PDF Datei beigelegt" ist Schwarze Schrift
"Mit freundlichen Grüßen." und "Oliver." ist Blaue Schrift
"Diese Nachricht, einschließlich anhängender Dateien, ist persönlich und kann vertraulich sein. Wenn Sie diese Nachricht irrtümlich erhalten, benachrichtigen Sie bitte den Absender und löschen Sie bitte die Originalnachricht und alle Kopien. Sie sollten die Nachricht ohne die Zustimmung des Absenders weder ganz noch teilweise kopieren, weiterleiten oder sonst wie weiterverbreiten." Das sollte Rote Schrift sein.
Kann mir Jemand dabei helfen das so umzustellen. Da ich es seit Tagen nicht hinbekommen habe
siehe Code unten
Private Sub Email_senden_pdf_Click()
'Email senden als pdf----------------------------
Dim app As Object
Dim file As String
Dim isNew As Boolean
Dim intCol As Integer
Dim lngRow As Long
Dim lngrowneu As Long
intCol = 1
With Worksheets(9)
If Application.WorksheetFunction.CountA( _
.Columns(intCol).EntireColumn) > 0 Then
lngRow = .Cells(.Rows.Count, intCol).End(xlUp).Row
End If
End With
Dim Bereich As String
Bereich = "A1:L" & lngRow
ActiveSheet.PageSetup.PrintArea = Bereich
file = ActiveSheet.Name & "_" & Format(Date, "DD.MM.YYYY") & "_" & Format(Time, "hh.mm") & "_" & ".pdf"
ActiveSheet.ExportAsFixedFormat xlTypePDF, Environ("TEMP") & "\" & file
On Error Resume Next
Set app = GetObject(, "Outlook.Application")
If app Is Nothing Then
Set app = CreateObject("Outlook.Application")
isNew = False
End If
With app.CreateItem(0)
.To = "max.muster@gmx.de"
.CC = ""
.BCC = ""
.Subject = "" & file
.Body = "Sehr geehrte Damen und Herren." & vbCr _
& vbCr _
& "Anbei die Excel Liste als PDF Datei beigelegt" & vbCr _
& vbCr _
& "Bitte informieren Sie mich sofort bei Unstimmigkeiten." & vbCr _
& "Mit freundlichen Grüßen." & vbCr _
& "Oliver." & vbCr _
& vbCr _
& "Diese Nachricht, einschließlich anhängender Dateien, ist persönlich und kann vertraulich sein. Wenn Sie diese Nachricht irrtümlich erhalten, benachrichtigen Sie bitte den Absender und löschen Sie bitte die Originalnachricht und alle Kopien. Sie sollten die Nachricht ohne die Zustimmung des Absenders weder ganz noch teilweise kopieren, weiterleiten oder sonst wie weiterverbreiten."
.Display
End With
If isNew Then app.Quit
End Sub
Ich habe im Internet so was gefunden und funktioniert auch.
wie kann ich so was in meine Code anpassen
With objOutApp
.Display
.To = Tabelle1.Range("C6")
.CC = Tabelle1.Range("C7")
.Subject = "Krankmeldung"
strTMP = .HTMLBody
Set objWordDoc = .GetInspector.WordEditor
objWordDoc.Content = "Sehr geehrte Damen und Herren," & _
vbCrLf & vbCrLf & "Infos folgen..." & vbCrLf & vbCrLf & _
"Viele Grüße" & vbCrLf & "Der Chef" & vbCrLf & vbCrLf
Set obgRange = objWordDoc.Range
obgRange.Collapse Direction:=wdCollapseEnd
obgRange.PasteAndFormat (wdTableAppendTable)
.HTMLBody = .HTMLBody & strTMP
End With
Meine Frage ist kann man das so umändern das die Signierung wie im Outlook die Schrift und Farbe übernimmt.
Im Outlook ist bei mir die was im .Body steht
"Sehr geehrte Damen und Herren." und "Anbei die Excel Liste als PDF Datei beigelegt" ist Schwarze Schrift
"Mit freundlichen Grüßen." und "Oliver." ist Blaue Schrift
"Diese Nachricht, einschließlich anhängender Dateien, ist persönlich und kann vertraulich sein. Wenn Sie diese Nachricht irrtümlich erhalten, benachrichtigen Sie bitte den Absender und löschen Sie bitte die Originalnachricht und alle Kopien. Sie sollten die Nachricht ohne die Zustimmung des Absenders weder ganz noch teilweise kopieren, weiterleiten oder sonst wie weiterverbreiten." Das sollte Rote Schrift sein.
Kann mir Jemand dabei helfen das so umzustellen. Da ich es seit Tagen nicht hinbekommen habe
siehe Code unten
Private Sub Email_senden_pdf_Click()
'Email senden als pdf----------------------------
Dim app As Object
Dim file As String
Dim isNew As Boolean
Dim intCol As Integer
Dim lngRow As Long
Dim lngrowneu As Long
intCol = 1
With Worksheets(9)
If Application.WorksheetFunction.CountA( _
.Columns(intCol).EntireColumn) > 0 Then
lngRow = .Cells(.Rows.Count, intCol).End(xlUp).Row
End If
End With
Dim Bereich As String
Bereich = "A1:L" & lngRow
ActiveSheet.PageSetup.PrintArea = Bereich
file = ActiveSheet.Name & "_" & Format(Date, "DD.MM.YYYY") & "_" & Format(Time, "hh.mm") & "_" & ".pdf"
ActiveSheet.ExportAsFixedFormat xlTypePDF, Environ("TEMP") & "\" & file
On Error Resume Next
Set app = GetObject(, "Outlook.Application")
If app Is Nothing Then
Set app = CreateObject("Outlook.Application")
isNew = False
End If
With app.CreateItem(0)
.To = "max.muster@gmx.de"
.CC = ""
.BCC = ""
.Subject = "" & file
.Body = "Sehr geehrte Damen und Herren." & vbCr _
& vbCr _
& "Anbei die Excel Liste als PDF Datei beigelegt" & vbCr _
& vbCr _
& "Bitte informieren Sie mich sofort bei Unstimmigkeiten." & vbCr _
& "Mit freundlichen Grüßen." & vbCr _
& "Oliver." & vbCr _
& vbCr _
& "Diese Nachricht, einschließlich anhängender Dateien, ist persönlich und kann vertraulich sein. Wenn Sie diese Nachricht irrtümlich erhalten, benachrichtigen Sie bitte den Absender und löschen Sie bitte die Originalnachricht und alle Kopien. Sie sollten die Nachricht ohne die Zustimmung des Absenders weder ganz noch teilweise kopieren, weiterleiten oder sonst wie weiterverbreiten."
.Display
End With
If isNew Then app.Quit
End Sub
Ich habe im Internet so was gefunden und funktioniert auch.
wie kann ich so was in meine Code anpassen
With objOutApp
.Display
.To = Tabelle1.Range("C6")
.CC = Tabelle1.Range("C7")
.Subject = "Krankmeldung"
strTMP = .HTMLBody
Set objWordDoc = .GetInspector.WordEditor
objWordDoc.Content = "Sehr geehrte Damen und Herren," & _
vbCrLf & vbCrLf & "Infos folgen..." & vbCrLf & vbCrLf & _
"Viele Grüße" & vbCrLf & "Der Chef" & vbCrLf & vbCrLf
Set obgRange = objWordDoc.Range
obgRange.Collapse Direction:=wdCollapseEnd
obgRange.PasteAndFormat (wdTableAppendTable)
.HTMLBody = .HTMLBody & strTMP
End With
![[-]](https://www.clever-excel-forum.de/images/collapse.png)