860to864: Arbeitsmappe per Mail versenden

Sub Arbeitsblatt_versenden()
'aktives Tabellenblatt als Arbeitsmappe
'im Temporären Ordner speichern, als
'Anlage mit Outlook versenden und anschliesend löschen
Dim strPath As String
Dim strName As String
Dim strFile As String
strPath = "C:\Windows\Temp\" 'Pfad
strName = Range("A1")
If strName = "" Then Exit Sub
'strName = ActiveSheet.Name 'Tabellenname
strFile = strPath & strName & ".xls"
Application.ScreenUpdating = False
ActiveSheet.Copy
Cells.Select
Selection.Copy
Call Verknuepfungen_löschen
'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
' False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
With ActiveWorkbook
.SaveAs strFile
Senden strFile 'Datei versenden
.Close
End With
Kill strFile 'Datei löschen
Application.ScreenUpdating = True
End Sub

Sub Senden(AWS As String)
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = ActiveSheet.Range("B1")
.Subject = InputBox(strName) '"strName" ' "Betreffzeile Header"
.Attachments.Add AWS
'.Body = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'.Send
End With
'OutApp.Quit
'Set OutApp = Nothing
'Set Nachricht = Nothing
End Sub

Sub Verknuepfungen_löschen()
ActiveSheet.Unprotect
On Error GoTo Errorhandler
Do
Cells.Find(What:=".XLS", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Loop
Errorhandler:
End Sub