none
Batch Print Report Forms to PDF and Email it RRS feed

  • Question

  • Hello Mr. Hans,

    I'm very glad to find a very useful thread here. I am in need of macros to do few tasks to create reports:

    1. I have a worksheet(Sheet4) set to be the report layout, and a list box (contains 30-50 entries from Sheet1) in it

    2. All other cells containing information of the particular entry in the list box is generated by vlookup based on the value in the listbox.

    What I need to do are:

    1. Create PDF file from each entry in the listbox (ignore the blank entries in the listbox

    2. Email the PDF file to each of their email addresses (value is located at Sheet1, Column B for example)

    I have tried this commands useful but it can't loop to the next entry in the list box, and it doesn't help to email the pdf file.

    Sub PDFActiveSheetNoPromptCheck()

    Dim wsA As Worksheet
    Dim wbA As Workbook
    Dim strName As String
    Dim strPath As String
    Dim strFile As String
    Dim strPathFile As String
    Dim myFile As Variant
    Dim lOver As Long
    On Error GoTo errHandler

    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet

        'get active workbook folder, if saved
        strPath = wbA.Path
        If strPath = "" Then
          strPath = Application.DefaultFilePath
        End If
        strPath = strPath & "\"
        
        strName = wsA.Range("D8").Value _
                  
        
        'create default name for savng file
        strFile = strName & ".pdf"
        strPathFile = strPath & strFile
        
        If bFileExists(strPathFile) Then
          lOver = MsgBox("Overwrite existing file?", _
            vbQuestion + vbYesNo, "File Exists")
          If lOver <> vbYes Then
            'user can enter name and
            ' select folder for file
            myFile = Application.GetSaveAsFilename _
              (InitialFileName:=strPathFile, _
                  FileFilter:="PDF Files (*.pdf), *.pdf", _
                  Title:="Select Folder and FileName to save")
            If myFile <> "False" Then
              strPathFile = myFile
            Else
              GoTo exitHandler
            End If
          End If
        End If
        
        'export to PDF in current folder
        wsA.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=strPathFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False


    exitHandler:
        Exit Sub
    errHandler:
        MsgBox "Could not create PDF file"
        Resume exitHandler
    End Sub
    '=============================
    Function bFileExists(rsFullPath As String) As Boolean
      bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
    End Function
    '=============================


    I would really appreciate if you can help me with this task. Thank you very much.

    Warm Regards,

    Eric

    Thursday, April 11, 2019 5:38 AM

All replies

  • What is the rowsource / listfillrange of the list box?

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, April 11, 2019 11:42 AM
  • Thanks for the Reply, Mr. Hans.

    The rowsource is from Sheet1!B4:B90. It is a data validation ListBox.

    Thanks in advance :D

    Thursday, April 11, 2019 4:39 PM
  • I assume that you want to use the values from Sheet1 column B for the file names, and that the email addresses are in another column, for example column D.

    Sub PDFActiveSheetNoPromptCheck() Dim wsA As Worksheet Dim wbA As Workbook Dim wsL As Worksheet Dim strName As String Dim strPath As String Dim strFile As String Dim strPathFile As String Dim myFile As Variant Dim rngCell As Range Dim olApp As Object Dim blnStart As Boolean Dim olMessage As Object ' Reference to Outlook On Error Resume Next Set olApp = GetObject(Class:="Outlook.Application") If olApp Is Nothing Then Set olApp = CreateObject(Class:="Outlook.Application")
    olApp.Session.Logon blnStart = True End If On Error GoTo errHandler Set wbA = ActiveWorkbook Set wsA = ActiveSheet Set wsL = wbA.Worksheets("Sheet1") 'get active workbook folder, if saved strPath = wbA.Path If strPath = "" Then strPath = Application.DefaultFilePath End If strPath = strPath & "\" ' Loop through the row source of the list box For Each rngCell In wsL.Range("B4:B90") If rngCell.Value <> "" Then strName = rngCell.Value wsA.Range("D8").Value = strName 'create name for saving file strFile = strName & ".pdf" strPathFile = strPath & strFile 'export to PDF in current folder wsA.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=strPathFile, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False ' Create email message Set olMessage = olApp.CreateItem(0) ' olMailItem With olMessage ' Email address is 2 columns to the right of rngCell .Recipients.Add rngCell.Offset(0, 2).Value .Subject = "Your subject goes here" .Body = "Your message text goes here." & vbCrLf & _ "Yours sincerely," & _ "Your name/company goes here" .Attachments.Add strPathFile ' For testing, use .Display instead of .Send .Send End With ' Optional: delete the PDF file after sending Kill strPathFile End If Next rngCell exitHandler: On Error Resume Next ' If we started Outlook, we quit it If blnStart And Not olApp Is Nothing Then olApp.Quit End If Exit Sub errHandler: MsgBox "Could not create PDF file" Resume exitHandler End Sub

    Modify the subject and body of the message as needed.

    Remark: the code works best if Outlook is already running.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, April 11, 2019 8:24 PM
  • Hello again Mr. Hans. Thank you so much for doing me a favor. I have tried the code and it shows "Could not create pdf". Does it mean that it runs into error when opening outlook? I have my outlook opened and signed in to 4 company email addresses.

    The report form (which I need to send as pdf attachment to each of them) is in Sheet4, containing a ListBox (cell D8, values are their names) from source Sheet1 Column B, and the their email addresses are in Column G.

    Best regards,

    Eric

    • Edited by EricYap Friday, April 12, 2019 4:20 AM
    Friday, April 12, 2019 4:19 AM
  • 1) Change the line

                    .Recipients.Add rngCell.Offset(0, 2).Value

    to

                    .Recipients.Add rngCell.Offset(0, 5).Value

    since the email address in column G is 5 columns to the right of column B.

    If that doesn't help:

    2) Change the line

        On Error GoTo errHandler

    to

        On Error GoTo 0

    When you run the macro and the error occurs, click Debug.

    What does the error message say this time, and which line is highlighted?


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, April 12, 2019 6:55 AM
  • Hi Hans. sorry for late reply. I've tried the changes as instructed. It highlights the line "Set wsL = wbA.Worksheets("Sheet1")"
    Sunday, April 14, 2019 2:36 AM
  • Change Sheet1 to the actual name of the worksheet that contains the row source of the list box (i.e. the list of names).

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Sunday, April 14, 2019 8:10 AM
  • Finally Hans! The codes work fine. It can generate each of the pdfs and batch send all the pdfs as attachment to each of them. Thank you so much for helping me. I just can't express how grateful I am for the favor you've done. Now I can send all the reports more easy and simple in just one click.

    Wish you success and goodluck always. GBU

    Best Regards,

    Eric

    Sunday, April 14, 2019 3:39 PM