AW: Mail in Excel nur Tabellenblatt
11.03.2014 13:02:18
Klaus
Hallo Bommi,
so (mit Outlook!):
Option Explicit
'Module to send Excel-Sheet directly with outlook
'April 2013 by Klaus M.vdT.
'original Code by mumpel / www.herber.de / 11.04.2013 11:23:25
'https://www.herber.de/forum/messages/1308295.html
Sub SendExample()
'give variables to send-Makro like this!
Dim wkbThisBook As Workbook
Dim sSheet As String
Dim sText As String
Dim sTo As String
Dim sCC As String
Dim sSubject As String
Set wkbThisBook = ActiveWorkbook
sSheet = ActiveSheet.Name
sTo = "Frank Farmer ; Karl Ransaier "
sCC = ""
sText = "Dear Colleages
find mail attached
more text"
sSubject = "Todays File"
Call SendSheetOutlook(wkbThisBook, sSheet, sSubject, sTo, sCC, sText)
'CALL possible in one line!
'Call SendSheetOutlook(ActiveWorkbook, "Sheet1", "Todays File", "Frank Farmer ; Karl Ransaier ", _
"", "Dear Colleages find mail attached ")
End Sub
Private Sub SendSheetOutlook(wkbOld As Workbook, wksOld As String, sSubject As String, sTo As _
String, sCC As String, sText As String)
Dim olApp As Object
Dim AWS As String
Dim olSheetsCount As Integer
Dim olOldBody As String
'define temporary Path and Filename
AWS = wkbOld.Path & "\" & Format(Date, "YYYYMMDD") & "_" & Format(Time, "hhmmss") & "_" & _
wkbOld.Name
'remember ammount of tables for new sheet
olSheetsCount = Application.SheetsInNewWorkbook
'set ammount of tables to one, so new file will not have 3-x empty tables
Application.SheetsInNewWorkbook = 1
'add new empty workbook. Will be in FOCUS from now on!
Workbooks.Add
'restore ammount of tables to old value
Application.SheetsInNewWorkbook = olSheetsCount
'copy entire sheet
wkbOld.Sheets(wksOld).Cells.Copy
'paste into new sheet as values, save sheet and close sheet under TEMP filename
With ActiveWorkbook
.Sheets(1).Range("A1").PasteSpecial xlPasteValues
.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
.SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close
End With
'Make Email
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.GetInspector.Display
olOldBody = .htmlBody
.To = sTo
.cc = sCC
.Subject = sSubject
.htmlBody = sText & olOldBody
.Attachments.Add AWS
End With
'remove TEMP file
Kill AWS
End Sub
Grüße,
Klaus M.vdT.