MS Access VBA添付ファイル付き電子メールを送信

Question

Accessデータベースから複数の電子メールアドレスにレポートをエクスポートしようとしましたが、これは作成したテーブルとレポートを使用しています。以下は私がこれを達成するために使っているコードです。

Function EmailNotification() 
On Error GoTo Err_EmailNotification 
    Dim olApp As Object 
    Dim olMail As Object 
    Set olApp = CreateObject("Outlook.Application") 
    Set olMail = olApp.CreateItem(olMailItem) 
    Dim EmailList As String 
    Dim EmailList2 As String 
    Dim objOutlookRecip As Object 
    Dim objOutlookRecip2 As Object 
    Dim objOutlookAttach As Object 
    Const TERMINAL_QUERY = "SELECT EMail " & _ 
          " FROM [EmailList] " & _ 
          " ORDER BY Email;" 

    Dim dbs As DAO.Database 
    Dim rst1 As DAO.Recordset 
    DoCmd.OutputTo acOutputReport, "CarryIn_Email", "PDFFormat(*.pdf)", "Q:\2017\Big E Transportation\Accounting\Advanced Auto\Projects Summary Report.PDF", False, " , acExportQualityPrint" 
     Set dbs = CurrentDb() 
     Set rst1 = dbs.OpenRecordset(TERMINAL_QUERY) 
     With rst1 
      .MoveFirst 
      .MoveLast 
      .MoveFirst 
      rstX = rst1.RecordCount 
      If Not (.EOF And .BOF) Then 
       .MoveFirst 
       Do Until .EOF 
        Set olApp = CreateObject("Outlook.Application") 
        Set olMail = olApp.CreateItem(olMailItem) 
        With olMail 
         Set objOutlookRecip = .Recipients.Add(rst1!Email) 
         objOutlookRecip.Type = olTo 
         .Subject = "Carry Ins" 
         SETOBJOUTLOOKATTACH = .Attachments.Add("Q:\2017\Big E Transportation\Accounting\Advanced Auto\Projects Summary Report.PDF") 
         .Send 
        End With 
        .MoveNext 
       Loop 
      End If 
     End With 

Exit_EmailNotification: 
    Exit Function 

Err_EmailNotification: 
    MsgBox Error$ 
    Resume Exit_EmailNotification 

End Function 

このコードでは、PDFが添付された電子メールをエクスポートするのではなく、電子メールを添付ファイルとしてエクスポートしています。

このコードでは、電子メールを添付ファイルとした電子メールではなく、PDF添付ファイル付きの電子メールをエクスポートします。

Answer 1

関数は、何かを計算し結果を返すために使用されるプロシージャです。上記の関数は何も返さない。

サブルーチンは、プロセス内のステップを実行し、結果を返さないプロシージャです。

以下にコードは、あなたが達成しようとしているかを満たす必要があります。

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