• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Excel VBA code to write Print Area as PDF and email

George-1947

New Member
Hello, I have created an excel workbook that uses =Indirect(“Data!A &RowIndex”) to pull data 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:


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
       .Item.to = "(email addresses here)"
       .Item.Subject = "Monthly Meeting"
       .Item.Send
      '.Item.Display
      End With
    Next i
End Sub
 

Attachments

  • Sample-1.xlsm
    70.8 KB · Views: 7
Last edited:
Back
Top