Please try this version:
Code:
Option Compare Database
Option Explicit
Private Sub cmd_Output_Certificates_To_Individual_PDFs_Click()
Dim rs As DAO.Recordset
Dim sFolder As String
Dim sFile As String
Dim sSubject As String
Dim sBody As String
Dim sEmailAddress As String
Dim MyDB As DAO.Database
'On Error GoTo Error_Handler
'sFolder = Application.CurrentProject.path & "\"
sFolder = "C:\Users\FSESO\Desktop\Back to Work\0 Reconciliation\Certificates\Certificates To Be Sent" & "\"
'sEmailAddress = [f_Certificates]![txt_Home_Email]
Set MyDB = CurrentDb
Set rs = MyDB.OpenRecordset("q_Certificates_To_Email")
With rs
.MoveFirst
Do While Not .EOF
'DoCmd.OpenReport "r_Certificates", acViewPreview, , "[LName]= '" & ![LName] & "'", acHidden
DoCmd.OpenReport "r_Certificates", acViewPreview, , "[LName]= '" & Replace(![LName], "'", "''") & "'"
sFile = Nz(![LName], "") & "_" & Nz(![Nickname], "") & "_Restart_Certificate" & ".pdf"
sFile = sFolder & sFile
DoCmd.OutputTo acOutputReport, "r_Certificates", acFormatPDF, sFile, , , , acExportQualityPrint
'If you wanted to create an e-mail and include an individual report, you would do so now
DoCmd.Close acReport, "r_Certificates"
sSubject = " Certificate for " & ![FNAME] & " " & ![LName]
sEmailAddress = ![Home Email]
Call vcSendEmail_Outlook(sEmailAddress, , , , sFile, "Enter body of message if template does not provide it")
.MoveNext
Loop
End With
Application.FollowHyperlink sFolder 'Optional / Open the folder housing the files
Error_Handler_Exit:
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Exit Sub
Error_Handler:
If Err.Number <> 2501 Then 'Let's ignore user cancellation of this action!
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: cmd_Output_Certificates_To_Individual_PDFs" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
End If
Resume Error_Handler
End Sub
Function vcSendEmail_Outlook(sTo As String, Optional sSubject As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
'Set OutMail = OutApp.CreateItem(0)
Set OutMail = Application.CreateItemFromTemplate("C:\My Outlook Templates\Restart Process Completion Certificate.oft")
OutMail.To = sTo
If sCC <> "" Then OutMail.CC = sCC
If sBcc <> "" Then OutMail.BCC = sBcc
If sSubject <> "" Then OutMail.Subject = sSubject
If sBody <> "" Then OutMail.HTMLBody = sBody
OutMail.Attachments.Add (sAttachment)
OutMail.Display 'Send | Display
Set OutMail = Nothing
Set OutApp = Nothing
End Function
You could not remove sSubject in the first version as it was a required argument, you needed to remove it in the function as I mentioned in the previous post.
Note that I've changed the function (renamed it too) to make the subject line optional (also moved it as the second argument). Please let me know!
Cheers,
Windows 10 
Access 2010 32bit
Reply With Quote
Originally Posted by Gicu
I have a question and a few comments.......
)
