| Sub Mail_Senden_mit_PDF1() |
| Erstellt Mail mit PDF im Anhang und speichert das PDF im Ordner ab |
| |
| Dim WSh As Worksheet |
| Dim sMailtext As String, sSignatur As String |
| Dim sDateiName As String, T As String |
| |
| '<<<Tabellenblatt anpassen>>> |
| Set WSh = ThisWorkbook.Sheets("A") 'Blatt mit Maildaten |
| |
| sDateiName = ThisWorkbook.FullName |
| sDateiName = Left$(sDateiName, InStrRev(sDateiName, ".")) & "pdf" |
| |
| T = ThisWorkbook.Path & "\" |
| |
| sDateiName = Replace(sDateiName, T, T) |
| |
| |
| |
| |
| '<<<Tabellenblatt anpassen>>> |
| ThisWorkbook.Sheets("A").ExportAsFixedFormat Type:=xlTypePDF, _ |
| Filename:=sDateiName, Quality:=xlQualityStandard, _ |
| IncludeDocProperties:=True, _ |
| IgnorePrintAreas:=False, OpenAfterPublish:=True |
| |
| With CreateObject("Outlook.Application").CreateItem(0) |
| .BodyFormat = 2 'HTML-Format, Angabe optional |
| .Subject = "Idee " & WSh.Range("A1").Value 'Betreff |
| |
| .To = Replace(WSh.Range("G8").Value, vbLf, ";") 'Empfänger |
| |
| |
| |
| sMailtext = "Guten Tag," & vbLf & vbLf & "Wie geht’s? " _ |
| & WSh.Range("A1").Value & "." & vbLf & "Gut." |
| .GetInspector: sSignatur = .HTMLBody 'Signatur holen |
| .HTMLBody = "<span style='font-family:Calibri;font-size:11.5pt;color:black;'>" _ |
| & Replace(sMailtext, vbLf, "<br>") & "</span>" & sSignatur |
| '.HTMLBody = Replace(sMailtext, vbLf, "<br>") & sSignatur |
| .Display |
| |
| 'Anlage anfügen |
| If Dir$(sDateiName) <> "" Then |
| .Attachments.Add sDateiName 'Anlage anfügen |
| End If |
| |
| End With |
| |
| End Sub |