Automatisch Email versenden

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim xOutApp As Object
Dim xMailItem As Object
Dim xName As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xName = ActiveWorkbook.FullName
With xMailItem
.To = ""
.CC = ""
.Subject = "Diese Datei wurde unter einer neuen Version gespeichert"
.Body = "Hallo," & Chr(13) & Chr(13) & "Fyi, die Datei wurde geupdated :)."
.Attachments.Add xName
.Display
'.send
End With
Set xMailItem = Nothing
Set xOutApp = Nothing
End Sub