AW: VBA Tabellenblatt als pdf UND xls mailen
25.06.2021 12:34:17
migre
Hallo!
Bspw. so:
Option Explicit
Sub AktivesBlattAlsExcelUndPdfMailen()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.ActiveSheet
Dim WbCopy As Workbook, WsCopy As Worksheet
Dim clc, XLpfad As String, PDFpfad As String
Dim OutlookApp As Object
Dim OutlookEmail As Object
Dim IsCreated As Boolean
With Application
clc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlookApp = CreateObject("Outlook.Application")
IsCreated = True
End If
On Error GoTo 0
If IsCreated Then OutlookApp.Quit
With Application
.Calculation = clc
.ScreenUpdating = True
End With
With Ws
.Copy
Set WbCopy = ActiveWorkbook
Set WsCopy = WbCopy.Sheets(1)
WsCopy.UsedRange.Value = WsCopy.UsedRange.Value
WbCopy.SaveAs Wb.Path & "\" & "Emailversand", 51
XLpfad = WbCopy.FullName
WbCopy.Close True
PDFpfad = Wb.Path & "\" & "Emailversand" & ".pdf"
Ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=PDFpfad, _
quality:=xlQualityStandard, _
includedocproperties:=True, _
ignoreprintareas:=False, _
openafterpublish:=False
Set OutlookEmail = OutlookApp.createitem(0)
With OutlookEmail
.Subject = "Betreff"
.To = "max@muster.de"
.CC = "moritz@probe.de"
.Body = "Hier kommt die Tabelle..."
.attachments.Add XLpfad
.attachments.Add PDFpfad
.display
End With
Kill XLpfad
Kill PDFpfad
End With
If IsCreated Then OutlookApp.Quit
With Application
.Calculation = clc
.ScreenUpdating = True
End With
Set Wb = Nothing: Set Ws = Nothing: Set WbCopy = Nothing
Set WsCopy = Nothing: Set OutlookApp = Nothing: Set OutlookEmail = Nothing
End Sub
Bsp-Mappe: https://www.herber.de/bbs/user/146798.xlsm
LG
Michael