Outlook nicht anzeigen, direkt versenden

Sub senden()
Dim outObj As Object
Dim Mail As Object
Dim i As Integer
Dim savepath As String
savepath = "c:\temp\" & ActiveSheet.Name & ".xls"
On Error Resume Next
Kill savepath
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs savepath
ActiveWorkbook.Close savechanges:=False
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
With Mail
.Subject = Sheets("Tabelle1").Cells(1, 1).Value
.Body = "Sehr geehrte Damen und Herren " & vbLf & _
"Bitte prüfen Sie die angehängten Rechnungen" & vbLf & _
"Viele Grüße " & vbLf & _
Application.UserName
.To = Sheets("Tabelle1").Cells(2, 2).Value
.CC = Sheets("Tabelle1").Cells(3, 2).Value
.Bcc = Sheets("Tabelle1").Cells(4, 2).Value
End With
With Application.FileSearch
.NewSearch
.LookIn = savepath
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles
.Execute
Mail.Attachments.Add savepath
End With
Mail.Display
Set Mail = Nothing
Set outObj = Nothing
End Sub