问MS Access VBA发送带有PDF附件的电子邮件

EN

Public Sub EmailNotification()
Dim olApp                           As Object
Dim olMail                          As Object
Dim strExport, strList              As String
Dim rst1                            As DAO.Recordset

Const TERMINAL_QUERY = "SELECT EMail " & _
                       "FROM [EmailList] " & _
                       "ORDER BY Email;"

On Error GoTo ErrorH
'Varibale to update one location for entire code
strExport = "Q:\2017\Big E Transportation\Accounting\Advanced Auto\Projects Summary Report.PDF"
'Ensures strList is empty for below check
strList = Empty
'Outputs the report to PDF using strExport variable
DoCmd.OutputTo acOutputReport, "CarryIn_Email", "PDFFormat(*.pdf)", strExport, False, " , acExportQualityPrint"
'Opens the recordset containing email addresses within const query above
Set rst1 = CurrentDb.OpenRecordset(TERMINAL_QUERY)
'ensure the recordset is fully loaded
rst1.MoveLast
rst1.MoveFirst
'loop to acquire email addresses from query statement, adding ";" to separate each email address
Do While Not rst1.EOF
    If strList = Empty Then
        strList = rst1![Email]
    Else
        strList = strList & "; "
    End If
    rst1.MoveNext
Loop
'Closes recordset and frees object in memory
rst.Close
Set rst = Nothing
'Creates the memory for email objects
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
'Generates email information
With olMail
    'olFormatPlain is easier to type in an email with, my opinion only, this line is not needed
    .BodyFormat = olFormatPlain
    'Who the email is going to, using the strList created during loop above
    .To = strList
    .CC = "" 'Change if you want a CC
    .BCC = "" 'Change is you want a BCC
    .Subject = "Carry Ins"
    .Body = "" 'Change to what ever you want the body of the email to say
    'Attaches the exported file using the variable created at beginning
    .Attachments.Add = strExport
    .Display 'Use for testing purposes only, note out for live runs
    '.Send 'Use for live purposes only, note out for test runs
End With

'Frees email objects stored in memory
Set olMail = Nothing
Set olApp = Nothing

EndCode:
'Ensures all objects are free from memory
If Not rst1 Is Nothing Then
    rst1.Close
    Set rst1 = Nothing
End If
If Not olApp Is Nothing Then
    Set olMail = Nothing
    Set olApp = Nothing
End If
Exit Sub

'Error handler to display error infor in message box, resumes end code
'Change is you want/need this to handle specific error numbers
ErrorH:
MsgBox Err.Number & " - " & Err.Description
Resume EndCode
End Sub