Hilfe kommt immer!
12.09.2003 07:51:28
Willie
Also ich habe es dir auf deine Wünsche angepasst! Es wird hier nur das Tabellen Blatt2
gespeigert und versendet! Wenn du mehrere Blätter schicken willst dann setzt dein Code
hier rein *** den du schon hast der das File erzeugt! Falls du noch Fragen hast stell
es einfach hier ins Forum.
Gruß
Willie
Sub junny()
Dim outObj As Object
Dim Mail As Object
Dim i As Integer
Dim savepath As String
savepath = "c:\temp\" & ActiveSheet.Name & ".xls" 'Hier ist die Zwischenablage!
On Error Resume Next
Kill savepath ' löscht die alte Datei an der Stelle weg ohne Rückfrage!
'*** Hier deine Code einfügen Mappe mit mehreren Blätter saveas 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 'Hier die Zelle angeben für Betreff
.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 'Hier kannst du deine Empfänger eintragen
.CC = Sheets("Tabelle1").Cells(3, 2).Value 'Wenn es mehrere sind musst du sie mit semicolon trennen! z.B. max@mustermann1.de;willie@mustermann1.de
.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