Tabellen Blatt an E-Mail anhängen
17.04.2019 09:47:30
Pascal
Ich habe folgendes Problem: Ich würde gerne einige Tabellen blätter in meinem Excel File markieren wollen und diese dann per Knopfdruck eine neue E-Mail erstellen mit den Tabellen blättern jeweils einzeln im Anhang aufgeleistet.
Ich habe hierzu schon etwas gefunden jedoch verbindet dieses Makro die Markierten Tabellen Blätter zu einer Excel Datei beziehungsweise einem Anhang.
Nun wollte ich fragen ob man dieses Makro vielleicht für mich umschreiben könnte.
Makro:
Sub Excel_Sheet_via_Outlook_Senden()
Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim AWS As String
SavePath = "C:\Temp" '"C:\Temp"
'Kopiert aktuelles Sheet in eine neue Mappe
'welche nur diese Tabelle enthält
ActiveWindow.SelectedSheets.Copy
'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel
ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & "_" & Format(Now, "ddmmyyyy") & ". _
_
_
_
xls"
'Mappenname wird an Variable übergeben
'und anschliessend gleich geschlossen
With ActiveWorkbook
AWS = .FullName
.Close
End With
'InitializeOutlook = True
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "xxxxxxx@xxx.de"
.Subject = "Die monatliche Datei" & Date & Time
'Hier wird die temporär gespeicherte Datei als
'Attachment zugefügt
.Attachments.Add AWS
'Hier wird eine normale Text Mail erstellt
'.body = "Die monatliche Datei" & vbCrLf & "Bitte bearbeiten."
'Hier wird die HTML Mail erstellt
.HTMLBody = "Anbei die monatliche Datei." & vbCrLf & "Bitte bearbeiten."
'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
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub
Danke & Viele Grüße,
Pascal