# Excel VBA code to write Print Area as PDF and email



## georgeawarriner (Apr 14, 2019)

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
```


----------

