Create PDF from Excel and Email.

Farrp001

New Member
Joined
Nov 17, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
I have been using a script from Christos (not sure if he is on here or anyone knows him). The script fills out a PDF with info from sheet and saves PDF. I have it working fine with my info but I want to be able to have it also email the, getting the email address from a field on pdf or sheet and email them as they are saved. Not sure if this is possible... Maybe seperate script that gets email address from pdf, attaches and email to that address. Any help would be greatly appreciated. Write part of the script below.

VBA Code:
Sub WritePDFForms()
 
    'Declaring the necessary variables.
    Dim strPDFPath              As String
    Dim strFieldNames(1 To 11)  As String
    Dim i                       As Long
    Dim j                       As Integer
    Dim LastRow                 As Long
    Dim objAcroApp              As Object
    Dim objAcroAVDoc            As Object
    Dim objAcroPDDoc            As Object
    Dim objJSO                  As Object
    Dim strPDFOutPath           As String
          
    'Disable screen flickering.
    Application.ScreenUpdating = False
   
    'Specify the path of the sample PDF form.
    'Full path example:
    'strPDFPath = "C:\Users\Christos\Desktop\Test Form.pdf"
    'Using workbook path:
    strPDFPath = ThisWorkbook.Path & "\" & "Test Form.pdf"
   
    'Set the required field names in the PDF form.
    strFieldNames(1) = "First Name"
    strFieldNames(2) = "Last Name"
    strFieldNames(3) = "Street Address"
    strFieldNames(4) = "City"
    strFieldNames(5) = "State"
    strFieldNames(6) = "Zip Code"
    strFieldNames(7) = "Country"
    strFieldNames(8) = "E-mail"
    strFieldNames(9) = "Phone Number"
    strFieldNames(10) = "Type Of Registration"
    strFieldNames(11) = "Previous Attendee"
   
    'Find the last row of data in sheet Write.
    With shWrite
        .Activate
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With
   
    'Loop through all rows of sheet Write and use the data to fill the PDF form.
    For i = 4 To LastRow
   
        On Error Resume Next
       
        'Initialize Acrobat by creating the App object.
        Set objAcroApp = CreateObject("AcroExch.App")
       
        'Check if the object was created.
        If Err.Number <> 0 Then
            MsgBox "Could not create the App object!", vbCritical, "Object error"
            'Release the object and exit.
            Set objAcroApp = Nothing
            Exit Sub
        End If
       
        'Create the AVDoc object.
        Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")
       
        'Check if the object was created.
        If Err.Number <> 0 Then
            MsgBox "Could not create the AVDoc object!", vbCritical, "Object error"
            'Release the objects and exit.
            Set objAcroAVDoc = Nothing
            Set objAcroApp = Nothing
            Exit Sub
        End If
       
        On Error GoTo 0
       
        'Open the PDF file.
        If objAcroAVDoc.Open(strPDFPath, "") = True Then
           
            'Set the PDDoc object.
            Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
          
            'Set the JS Object - Java Script Object.
            Set objJSO = objAcroPDDoc.GetJSObject
           
            On Error Resume Next
           
            'Fill the form fields.
            For j = 1 To 10
               
                objJSO.GetField(strFieldNames(j)).Value = CStr(shWrite.Cells(i, j + 1).Value)
               
                If Err.Number <> 0 Then
                   
                    'Close the form without saving the changes.
                    objAcroAVDoc.Close True
                   
                    'Close the Acrobat application.
                    objAcroApp.Exit
                   
                    'Inform the user about the error.
                    MsgBox "The field """ & strFieldNames(j) & """ could not be found!", vbCritical, "Field error"
                   
                    'Release the objects and exit.
                    Set objJSO = Nothing
                    Set objAcroPDDoc = Nothing
                    Set objAcroAVDoc = Nothing
                    Set objAcroApp = Nothing
                    Exit Sub
                   
                End If
            Next j
           
            'Fill the checkbox field.
            If shWrite.Cells(i, j + 1).Value = "True" Then
                objJSO.GetField(strFieldNames(11)).Value = "Yes"
            End If
           
            On Error GoTo 0
           
            'Create the output path, which will be like C:\Users\Christos\Desktop\Forms\01) First Name Last Name.pdf.
            With shWrite
                If i - 3 < 10 Then
                    strPDFOutPath = ThisWorkbook.Path & "\Forms\0" & i - 3 & ") " & .Cells(i, 2).Value & " " & .Cells(i, 3).Value & ".pdf"
                Else
                    strPDFOutPath = ThisWorkbook.Path & "\Forms\" & i - 3 & ") " & .Cells(i, 2).Value & " " & .Cells(i, 3).Value & ".pdf"
                End If
            End With
           
            'Save the form as new PDF file.
            objAcroPDDoc.Save 1, strPDFOutPath
   
            'Close the form without saving the changes.
            objAcroAVDoc.Close True
           
            'Close the Acrobat application.
            objAcroApp.Exit
              
            'Release the objects.
            Set objJSO = Nothing
            Set objAcroPDDoc = Nothing
            Set objAcroAVDoc = Nothing
            Set objAcroApp = Nothing
           
        Else
       
            MsgBox "Could not open the file!", vbCritical, "File error"
           
            'Close the Acrobat application.
            objAcroApp.Exit
           
            'Release the objects and exit.
            Set objAcroAVDoc = Nothing
            Set objAcroApp = Nothing
            Exit Sub
           
        End If
       
    Next i
   
    'Enable the screen.
    Application.ScreenUpdating = True
   
    'Inform the user that forms were filled.
    MsgBox "All forms were created successfully!", vbInformation, "Finished"
   
End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,749
Welcome to MrExcel forums.

It looks like the email addresses are in column 9 (I), so insert this line before the Next i line:

VBA Code:
        Send_Email ShWrite.Cells(i, 9).Value, strPDFOutPath
and add this routine to the module:
VBA Code:
Private Sub Send_Email(toEmail As String, fileAttachment As String)

    Static olApp As Object
    Dim olMsg As Object
    
    If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
    
    Set olMsg = olApp.CreateItem(0)
    With olMsg
        .To = toEmail
        .Subject = "Email subject here"
        .HTMLBody = "Email body text here"
        .Attachments.Add fileAttachment
        .Send
    End With
        
End Sub
 

Farrp001

New Member
Joined
Nov 17, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
Thank you for the response and sorry that was the raw script before I edited... In mine the emails are in Column C would this mean ,
Send_Email ShWrite.Cells(c, 3).Value, strPDFOutPath

would this work for multiple different pdf to corresponding email for that person or would i have to call out each one in a separate line... Sorry for my ignornce I am a laymen at best.
 

Farrp001

New Member
Joined
Nov 17, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
Following that format and attempting to run... Runtime Error "We need to know who to send this to" Debug is highlighting the .Send
 

Farrp001

New Member
Joined
Nov 17, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Capture.JPG
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,749
Thank you for the response and sorry that was the raw script before I edited... In mine the emails are in Column C would this mean ,
Send_Email ShWrite.Cells(c, 3).Value, strPDFOutPath

I thought the emails are in column I because of these lines:
VBA Code:
strFieldNames(8) = "E-mail"
VBA Code:
            For j = 1 To 10
               
                objJSO.GetField(strFieldNames(j)).Value = CStr(shWrite.Cells(i, j + 1).Value)
With the above, when j is 8, shWrite.Cells(i, j + 1) resolves to column 9, which is column I. The j + 1 suggests your data starts in column B, not A, Or you're ignoring column A.

With the data starting in column A and the emails in column C you need:
VBA Code:
strFieldNames(3) = "E-mail"
and adjust the other strFieldNames array indexes accordingly. And:
VBA Code:
            For j = 1 To 10
               
                objJSO.GetField(strFieldNames(j)).Value = CStr(shWrite.Cells(i, j).Value)

and:
VBA Code:
        Send_Email ShWrite.Cells(i, 3).Value, strPDFOutPath

would this work for multiple different pdf to corresponding email for that person or would i have to call out each one in a separate line... Sorry for my ignornce I am a laymen at best.
No, the code is looping through the rows and creating 1 PDF per row and emailing that PDF to one email address. You would have to change your data and/or the code to create or send multiple PDFs to each email address.
 
Solution

Farrp001

New Member
Joined
Nov 17, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
Sorry for my confusion and inability to explain better, my data does start in B so i, J+1 would resolve to i, 3... With that change it did run, but not sending the email... I really need it to send send the PDF email attachment to the email address in that column for the document created for that person. In practice this would be creating let say 10 PDFs for 10 separate people and emailing them to each person separately... Thank you for your help thus far.
 

Farrp001

New Member
Joined
Nov 17, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
Disregard, I had a typo and it appears to be doing just what I had described. Thank you so much.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,395
Messages
5,636,054
Members
416,894
Latest member
Hari1992

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top