Hyperlink in Serien-E-Mail in Makro

Sub E_Mail_Mgl_Abr_2_Info()
'Info E-Mail versenden aus Sheet Mgl_Abr_2
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim app   As Object
Dim file  As String
Dim isNew As Boolean
Dim olAPP As Object
Dim olOldBody As String
Dim signature As String
'aktueller Druckbereich A1:H61 ggf anpassen!
file = Sheets("Mgl_Abr_2").Range("L21").Text & ".pdf"
Sheets("Mgl_Abr_2").Range("A1:H564").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 = True
End If
With app.CreateItem(0)
.GetInspector.Display
.To = Sheets("Mgl_Abr_2").Range("M17").Value
.Cc = Sheets("Mgl_Abr_2").Range("M18").Value
.BCC = ""
.Subject = Sheets("Mgl_Abr_2").Range("L19").Value
.htmlbody = "" _
& Sheets("Mgl_Abr_2").Range("S55") _
& "

" & Sheets("Mgl_Abr_2").Range("S56") _
& "

" & Sheets("Mgl_Abr_2").Range("S57") _
& "

" & Sheets("Mgl_Abr_2").Range("S58") _
& "

" & Sheets("Mgl_Abr_2").Range("S59") _
& "

" & Sheets("Mgl_Abr_2").Range("S60") _
& "

" & Sheets("Mgl_Abr_2").Range("S61") _
& "

" & Sheets("Mgl_Abr_2").Range("S62") _
& "

" & Sheets("Mgl_Abr_2").Range("S63") _
& "

" & Sheets("Mgl_Abr_2").Range("S64") _
& "



	Bewerten Sie hier bitte das Excel-Portal
	

	

" & .htmlbody
'S59 und S62 Hyperlinks
.Attachments.Add Environ("TEMP") & "\" & file
.ReadReceiptRequested = True
End With
If isNew Then app.Quit
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub