VPA problem / Automatic pdf file saved in folder and send out via outlook out of a Print area

[TheExcelScrub]

Good day,

I have an urgent problem with my code.
I have this code from an Internet side and added it a bit with the help of Youtube tutorials.
This code works perfectly fine for all my Excel sheets i just need to change the folder every time the rest stays the same.
But now i have a new sheet and there the code is not working and i do not know why.
Below the code.
What I marked red is the bug that it shows me when i activate it.
Please help me I'm really frustrated!



Sub create_and_email_pdf()


' Create a PDF from the current sheet and email it as an attachment through Outlook


Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
CurrentMonth = ""


' *****************************************************
' ***** You Can Change These Variables *********


EmailSubject = "ALDI Layout " 'Change this to change the subject of the email. The current month is added to end of subj line
OpenPDFAfterCreating = False 'Change this if you want to open the PDF after creating it : TRUE or FALSE
AlwaysOverwritePDF = False 'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
DisplayEmail = True 'Change this if you don't want to display the email before sending. Note, you must have a TO email address specified for this to work
Email_To = ActiveSheet.Range("B2") 'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
Email_CC = ActiveSheet.Range("C2")
Email_body = ActiveSheet.Range("B3")
Email_Subject = ActiveSheet.Range("B6")

' ******************************************************

'Prompt for file destination
With Application.FileDialog(msoFileDialogFolderPicker)

If .Show = True Then

DestFolder = .SelectedItems(1)

Else

MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"

Exit Sub

End If

End With



'Create new PDF file name including path and file extension
PDFFile = "I:\Commercieel\Commercieel Wimke\ALDI\2019\Label 2019" & Application.PathSeparator & ActiveSheet.Range("B1") _
& ".pdf"


'If the PDF already exists
If Len(Dir(PDFFile)) > 0 Then

If AlwaysOverwritePDF = False Then

OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")

On Error Resume Next
'If you want to overwrite the file then delete the current one
If OverwritePDF = vbYes Then

Kill PDFFile

Else

MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"

Exit Sub

End If


Else

On Error Resume Next
Kill PDFFile

End If

If Err.Number <> 0 Then

MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"

Exit Sub

End If

End If



'Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating


'Create an Outlook object and new mail message
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

'Display email and specify To, Subject, etc
With OutlookMail

.Display
.To = Email_To
.CC = Email_CC
.BCC = Email_BCC
.body = Email_body
.Subject = Email_Subject
.Attachments.Add PDFFile

If DisplayEmail = False Then

'.Send

End If

End With


End Sub

 

[TheExcelScrub]

Please somebody answer I do not find a way

 

[DanteAmor]

What does the error message say?


All I see is it could be like this:

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, _
  Quality:=xlQualityStandard, IncludeDocProperties:=True, _
  IgnorePrintAreas:=False, OpenAfterPublish:=[B][COLOR=#0000ff]False[/COLOR][/B]