Function SendMail(AttachmentPath As String, _
Subject As String, _
Optional Adress As String, _
Optional Text As String)
'erstellt eine neue e-mail mit Anhang
 
Dim Outlk As New Outlook.Application
Dim OlkMsg As Outlook.MailItem
Set Outlk = GetApplication("Outlook.Application")
Set OlkMsg = Outlk.CreateItem(olMailItem)
 
With OlkMsg
    If Not IsMissing(Adress) Then .To = Adress
    .Subject = Subject
    .Attachments.Add AttachmentPath
    If Not IsMissing(Text) Then
        .Body = .Body & vbNewLine & Text & vbNewLine
    End If
        .Display
End With
End Function

Function GetApplication(ByVal AppClass As String) As Object
On Error Resume Next
Set GetApplication = GetObject(Class:=AppClass)
If Err.Number = 429 Then Set GetApplication = CreateObject(AppClass)
End Function