Outlook öffnen Datei einfügen,nicht versenden

Sub PDF_an_eMail()
Dim app   As Object
Dim file  As String
Dim isNew As Boolean
file = "Gesperrte Ware,  " & Format(Range("B1").Value, "ddd. dd. mmm yyyy") & ".pdf"
ActiveSheet.ExportAsFixedFormat xlTypePDF, Environ("TEMP") & "\" & file
Status = Shell("outlook.exe", 1) 'öffnet Outlook
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)
.To = Sheets("Artikeln").Range("Q2").Value
.CC = Sheets("Artikeln").Range("Q3")
.BCC = ""
.Subject = file
.Body = "Hallo," & vbCr _
& vbCr _
& "Gesperrte Ware,  " & Format(Range("B1").Value, "dddd dd mmmm yyyy") & vbCr _
& vbCr _
& "M.f.G"
.Attachments.Add Environ("TEMP") & "\" & file
'.Send
End With
End Sub