AW: Sheet als PDF per E-mail senden
09.11.2021 14:03:00
Klaus
Hallo Edi,
Hajo hätte jetzt geschrieben, "Du hast keine Datei hochgeladen also willst du es selbst zurecht basteln".
Anbei ein Makro, welches einzelne Tabellenblätter als xlsx verschickt. Den Part musst du umschreiben, dass das neue Tabellenblatt als PDF gespeichert wird und dann den Anhang entsprechend anpassen - oder vielleicht taugt es dir ja sogar schon, als xlsx zu verschicken.
Wenn du noch Hilfe brauchst, sag Bescheid! Aber dann bitte mit einer Musterdatei :-)
LG,
Klaus M.
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
'http://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 = "Tabelle1"
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)
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
'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
.SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbookMacroEnabled
'HIER ÄNDERN: SaveAs PDF
.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 'HIER ÄNDERN: PDF anhängen
End With
'remove TEMP file
Kill AWS
End Sub