Results 1 to 2 of 2

Thread: Generate and attach pdf to email without dialogue box
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Feb 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Generate and attach pdf to email without dialogue box

    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
    Code:
    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
    
    
    FUNCTIONS
    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
    Code:
    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
    Last edited by Fluff; Mar 28th, 2019 at 12:24 PM. Reason: code tags

  2. #2
    New Member
    Join Date
    Feb 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Generate and attach pdf to email without dialogue box

    I have solved this issue.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •