Option Explicit
Sub aktivesBlattToPdf()
Dim PDFFileName As String
Dim LastRow As Integer
Dim PDFPath As String
Dim OrderStatus As String
Dim OrderType As String
Dim SupplierName As String
Dim CRDConfirmed As String
Dim xOutlookObj As Object
Dim xEmailObj As Object
PDFPath = ThisWorkbook.Path & "\Style Sheet"
With Worksheets("Supplier_Sheet").AutoFilter.Range
OrderStatus = Range("A" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
SupplierName = Range("C" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
OrderType = Range("B" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
CRDConfirmed = Range("AG" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value
End With
PDFFileName = Range("D3") & "_" & OrderType & "_" & Range("F3") & "_" & SupplierName & "_" & CRDConfirmed & ".pdf"
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row
If Dir(PDFPath, vbDirectory) = "" Then
MsgBox "Please create a folder name: Style Sheet" <strong>(<--korrigiert copy/paste fehler oben aus falschem Code, bitte ignorieren)</strong>
Else
<strong>Sheets("Supplier_Sheet").Range("D2:AN" & LastRow).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
PDFPath & "\" & PDFFileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True</strong>
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
.To = ""
.CC = ""
.Subject = PDFFileName
.Attachments.Add PDFPath & "\" & PDFFileName
End With
End If
End Sub