Generate and attach pdf to email without dialogue box

[wes2422]

This is going to be a long one. I apologize.
I found some VBA script online (this is not something I wrote and can't take credit for any of it) that allows me to export and save the active range as a pdf and it automatically attaches it to an email with some predetermined verbiage. I have another command that I want to incorporate into this. Currently the script takes you to the dialogue box to type in a name you want for the pdf and save the pdf before it attaches to the email. The other command I want to replace it with automatically saves the pdf in the same location with the same name as the excel file and throws a date stamp on it. When I incorporate this command into this it will create the pdf but it wont attach it to the email. I cant seem to figure out how I need to alter the functions to make it work for this command. See existing button command and function below as well as the command I want to use to bypass the dialogue box completely.

Command

Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
    Dim FileName As String


    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "ungroup the sheets and try the macro again"
    Else
        'Call the function with the correct arguments
        'For a fixed range use this line
        FileName = RDB_Create_PDF(Source:=Range("B1:Z39"), _
                                  FixedFilePathName:="", _
                                  OverwriteIfFileExist:=True, _
                                  OpenPDFAfterPublish:=False)


        'For the selection use Selection in the Source argument
        'FileName = RDB_Create_PDF(Source:=Selection)


        'For a fixed file name use this in the FixedFilePathName argument
        'FixedFilePathName:="C:\Users\Ron\Test\YourPdfFile.pdf"


        If FileName <> "" Then
            RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                 StrTo:="", _
                                 StrCC:="", _
                                 StrBCC:="", _
                                 StrSubject:="RDC 3 Week Look Ahead", _
                                 Signature:=True, _
                                 Send:=False, _
                                 StrBody:="All,

" & _
                                          "******>Attached is the three week schedule. Please open the PDF to review." & _
                                          "

" & "Thanks,"
        Else
            MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                   "Microsoft Add-in is not installed" & vbNewLine & _
                   "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
                   "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                   "You didn't want to overwrite the existing PDF if it exist"
        End If
    End If
End Sub


[B]FUNCTIONS
[/B]Function RDB_Create_PDF(Source As Object, FixedFilePathName As String, _
                        OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant


        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                  Title:="Create PDF")


            'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If


        'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If


        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        Source.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0


        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End Function






Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
                              StrCC As String, StrBCC As String, StrSubject As String, _
                              Signature As Boolean, Send As Boolean, StrBody As String)
    Dim OutApp As Object
    Dim OutMail As Object


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        If Signature = True Then .Display
        .To = StrTo
        .CC = StrCC
        .BCC = StrBCC
        .Subject = StrSubject
        .HTMLBody = StrBody & "
" & .HTMLBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

What I want to incorporate

Sub ExportPDF()
    Dim sFile As String
    sFile = ThisWorkbook.Path & "" & ActiveWorkbook.Name & Format(Date, "mm-dd-yy")
    
    Sheets("Sheet1").Select
    ActiveSheet.PageSetup.PrintArea = "$B$1:$Z$39"
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
      FileName:=sFile, Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, IgnorePrintAreas:=False, _
      OpenAfterPublish:=True
End Sub

 

[wes2422]

I have solved this issue.