Excel VBA code to write Print Area as PDF and email

[georgeawarriner]

Excel VBA code to write Print Area as PDF and email
Hello, I have created a excel workbook that uses =Indirect(“Data!A &RowIndex”) to pull data through into my news letter layout.

In my news letter I have:
Member First Name in cell (Data!A1 &RowIndex)
Member Last Name in cell (Data!B1 &RowIndex)
Arrears in cell (Data!C1 &RowIndex)
Dues in cell (Data!D1 &RowIndex)
Total in cell (Data!E1 &RowIndex)
Email address in cell (Data!F1 &RowIndex)
The email body in Form cells B2:I48
the email subject is “Monthly Meeting”

I have a list of members’ Names in a worksheet called "Data" in Columns A & B

The email address is also in “Form” G5 if it is easier to extract from there.

The formula =Indirect(“xxx &RowIndex”) updates each newsletter and my current code produces an email with Print Range embedded in the news letter. I previously adapted a routine that printed the newsletter for each member to be mailed out. It can be emailed, but manually. I am just looking to amend this code to print to PDF, and then send the emails automatically.

Here is my current code:

  Public Const APPNAME As String = "Sample-1"
  Option Explicit
   
  Sub PrintForms()
      Dim StartRow As Integer
      Dim EndRow As Integer
      Dim Msg As String
      Dim MailDest As String
      Dim i As Integer
      
      Dim OutApp As Object
      Dim OutMail As Object
      Dim strbody As String
   
      Set OutApp = CreateObject("Outlook.Application")
      Set OutMail = OutApp.CreateItem(0)
      
      Sheets("Form").Activate
      StartRow = Range("StartRow")
      EndRow = Range("EndRow")
      
      If StartRow > EndRow Then
          Msg = "ERROR" & vbCrLf & "The starting row must be less than the ending row!"
          MsgBox Msg, vbCritical, APPNAME
      End If
      
      For i = StartRow To EndRow
          Range("RowIndex") = i
           ActiveSheet.Range("B7:I48").Select
          ActiveWorkbook.EnvelopeVisible = True
          With ActiveSheet.MailEnvelope
        '.Introduction = "This is a sample worksheet."
        .Item.to = "(email addresses here)"
        .Item.Subject = "Monthly Meeting"
        .Item.Send
        '.Item.Display
     End With
      Next i
  End Sub