Tabelle für Mail kopiert wird aber nicht gelöscht
09.06.2006 10:01:54
Torge
kann jemand helfen?
Hab mir aus dem Forum folgenden Code zusammengebastelt, nur leider wird das Tabellenbaltt nach dem Kopieren und Versenden per Mail - n i c h t - automatisch trotz "Kill" Anweisung gelöscht. Es kommt, nach dem das Blatt in den E-Mailausgang gelegt wird zwar die Anzeige "speichern, löschen, abbrechen" aber das Blatt bleibt aktiv und muss dann per Hand über Datei schließen gelöscht werden. Kann mir hier jemand unter die Arme greifen und helfen?
Hier der Code:
Private Sub CommandButton1_Click()
Dim bytMsg As Byte
Dim outObj As Object
Dim Mail As Object
Dim i As Integer
Sheets("Tabelle1").Copy
With ActiveSheet.Range("C2:AF268")
.Copy
End With
Application.CutCopyMode = False
bytMsg = MsgBox("Datei wurde in neue Mappe kopiert." & vbLf & _
"Soll der Bereich in Werte umgewandelt werden?", vbYesNo)
If bytMsg = vbYes Then
MsgBox "Der Dateiversand wird vorbereitet"
' Range("A1:BJ286").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Range("A1:BJ286").Select
Application.CutCopyMode = False
Application.WindowState = xlMinimized
Application.CutCopyMode = False
End If
'Mailversand als Anhang
Dim MyMessage As Object, myOutApp As Object
Dim SavePath As String
Dim AWS As String
SavePath = "C:"
'Kopiert aktuelles Sheet in eine neue Mappe
'welche nur diese Tabelle enthält
ActiveSheet.Copy
'Speichert die Datei unter dem Tabellennamen und dem Namen in A1
Debug.Print ActiveSheet.Name
Debug.Print ActiveSheet.Range("A1").Text
With ActiveWorkbook
.SaveAs SavePath & "\" & ActiveSheet.Name & " " & ActiveSheet.Range("A1").Text & ".xls"
'Aktive Arbeitsmappe soll asl Attachment vesandt werden
AWS = ActiveWorkbook.FullName
.Close
End With
Set myOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = myOutApp.CreateItem(0)
With MyMessage
.To = "info@ifvs-gmbh.de"
.Subject = "Fin.-Plan Anfrage " & Date & Time
'Hier wird die temporär gespeicherte Datei als
'Attachment zugefügt
.Attachments.Add AWS
'Hier wird eine normale Text Mail erstellt
'.body = "Das ist ein Test" & vbCrLf & "Bitte ignorieren"
'Hier wird die HTML Mail erstellt
.HTMLBody = "Das ist ein Test von Torge." & vbCrLf & "Bitte ignorieren oder speichern."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
' .Send
'Hier wird die temporäre Datei wieder gelöscht
Kill AWS
End With
myOutApp.Quit
Set myOutApp = Nothing
Set MyMessage = Nothing
End Sub
Vielen, vielen Dank an der Stelle
Gruß Torge