Need Access to generate smaller PDF

Function send_emailcap_mtd()
   On Error GoTo Err_Send_Click
 
    Dim mydb As Database, RS As Recordset
    Set mydb = DBEngine.Workspaces(0).Databases(0)
    Dim attachPDF As String
    Dim docname As String, ctl As Control, strTo As String
    Dim path As String, subject As String, body As String
    Dim attach As String, blnSuccessful As Boolean
         
     Application.Echo False
    
    Set RS = mydb.OpenRecordset("qry_emailcap_mtd")
        
    path = "c:\temp\"
    docname = "emailcap_mtd"
    attachPDF = path + docname & ".pdf"
    subject = "Email Address Capture Report"
    body = "Daily Report is Attached"
    DoCmd.OutputTo acOutputReport, docname, acFormatPDF, attachPDF
 
 Do Until RS.EOF
      strTo = RS!Email
       blnSuccessful = FnSafeSendEmail(strTo, subject, body, attachPDF, "", "")
       RS.MoveNext
    Loop
    RS.Close
    Set RS = Nothing
    Set mydb = Nothing
 
exit_send_click:
     
    Application.Echo True
    Exit Function
 
Err_Send_Click:
    Resume exit_send_click
     
End Function

Select allOpen in new window