I appologize for the delay in updating this answer. here is the results for this issue: I selected Event Procedure adn this works -
Private Sub Email_Record_Click()
On Error GoTo Err_Email_Record_Click
'Email Loop to capture all email addresses
Dim strArr As String
strArr = EmailTo
Dim stDocName As String
Dim rst As Recordset
Dim strwho As String
DoCmd.SetWarnings False
DoCmd.OpenQuery "MyEMailAddresses"
DoCmd.OpenQuery "Print PI"
Set rst = CurrentDb.OpenRecordset("tblEmailList")
rst.MoveFirst
Do Until rst.EOF
If IsNull(rst!PreparedEmail) Then
Else
strwho = rst!PreparedEmail & ";" & strwho
strwho = rst!PMEmail & ";" & strwho
strwho = rst!PEMEmail & ";" & strwho
strwho = rst!QEEmail & ";" & strwho
strwho = rst!ME1Email & ";" & strwho
strwho = rst!InspectionEmail & ";" & strwho
strwho = rst!SOREmail & ";" & strwho
strwho = rst!SCMEmail & ";" & strwho
strwho = rst!SQEEmail & ";" & strwho
strwho = rst!PQMEmail & ";" & strwho
strwho = rst!OpMEmail & ";" & strwho
strwho = rst!ConfigEmail & ";" & strwho
strwho = rst!ContractsEmail & ";" & strwho
'strwho = rst!ApprovalEmail & ";" & strwho
End If
rst.MoveNext
Loop
MsgBox strwho
stDocName = "QPIReport"
DoCmd.SendObject acSendReport, stDocName, acFormatPDF, strwho, "email address; [email]email address[/email]", , "New/Updated QPI", "Please review attached file. Respond if there is any discrepancie's.", True
Exit_Email_Record_Click:
Exit Sub
Err_Email_Record_Click:
MsgBox Err.Description
Resume Exit_Email_Record_Click
End Sub