Report from Access 2010 to E-Mail

Topic

New Reply

I have a Database which produces a transaction listing by member. Sort of like a customers statement showing an Address block, Invoices, Payments, and a balance. These are transaction records keyed by Member Id). The report forces a newpage on change of Member Id. So Far So Good. This works and I can fold each page of the report, stuff it into a Window envelope and send by post.

BUT! would’nt it be nice (and cheaper), to send each seperate page via e-mail. (And just to make it a bit different, add a .pdf newsletter as an attachment to each e-mail).

ANY ideas on how to go about this would be apppreciated. I think some kind of Do Loop would be required, but not sure how to relate this to a page of the Report.

Note: The Newsletter would be the same for each recipient, but the Page of the report of course would show different data

Devious

Reply | Quote

Replies

Dude,

Been there done that.

I maintain the DB for our HOA and I have it setup to check if the owner has authorized their annual dues bill to be emailed and if so to do just that.

Here’s some code you can peruse.

Code:

'                         +-------------------------+             +----------+
 '-------------------------|      EmailBills()       |-------------| 01/11/12 |
 '                         +-------------------------+             +----------+
 'Requires : PDFCreator {Open Source PDF Printer Driver}
 '           Sleep      {Windows API Function Declaration}
 'Called By: Switchboard
 'Calls: ClearPDFDirectory()
 '       SetDateForBills()
 '       [Utilities] SwitchPrinters()
 '       [Utilities] zGetDBPath()

 Sub EmailBills()

    Dim dbName     As Database
    Dim rst        As Recordset
    Dim lRecNo     As Long
    Dim lBillCnt   As Long
    Dim zWhere     As String
    Dim zMsgBody   As String
 #If LateBinding = 0 Then    'Early Binding
    Dim appOL      As Outlook.Application
    Dim miMail     As Outlook.mailitem
 #Else
    Dim appOL      As Object
    Dim miMail     As Object
 #End If

    Dim oMyAttach  As Object
    Dim zAttFN     As String
    Dim zBillPath  As String
   
    Forms![Switchboard].Visible = False
    If Not SetDateForBills() Then
      Forms![Switchboard].Visible = True
      Exit Sub
    End If
   
    MsgBox "Please Note:" & vbCrLf & vbCrLf & _
           "If Microsoft Outlook is Closed the created Emails " & vbCrLf & _
           "will be sent to the INBOX folder." & vbCrLf & vbCrLf & _
           "If Microsoft Outlook is OPEN {recommended} the created Emails " _
           & vbCrLf & "will be sent to the DRAFTS folder." & vbCrLf & vbCrLf & _
           "When OUTLOOK is properly set press OK", _
           vbOKOnly + vbInformation, _
           "IMPORTANT INFORMATION:"
          
    zBillPath = zGetDBPath() & "EmailBills"
          
    ClearPDFDirectory
    strDfltPrt = Application.Printer.DeviceName
    SwitchPrinters "PDFCreator"
   
    Set appOL = CreateObject("Outlook.Application")
    Set dbName = CurrentDb()
    Set rst = dbName.OpenRecordset("Owners", dbOpenDynaset)
    rst.MoveFirst
   
    lBillCnt = 0
    zMsgBody = "Please find your WPOA annual dues statement attached." & _
               vbCrLf & vbCrLf & "WOPA Board of Directors" & vbCrLf & _
               vbCrLf & "Attachment: "
    Do
      If (rst![EMailDocs] And rst![EMail]  "") Then
     
        zWhere = "[OwnerID] = " & Str(rst![OwnerID])
   
 'Note: If acNormal is selected the report is send automatically to the
 '      Default printer!
 '      If acPreview is selected the report is sent to the screen.

        DoCmd.OpenReport "rptAnnualBilling", acNormal, , zWhere
   
 '******* Rename file with OwnerID

 On Error GoTo WaitForPDFCreator
 Try_Again:

        Do While Dir(zBillPath & "rptAnnualBilling.pdf") = vbNullString
          Sleep 1250           '** wait 1.25 secs before trying again **
        Loop
       
        Name zBillPath & "rptAnnualBilling.pdf" As _
             zBillPath & "Bill" & Format(rst![OwnerID]) & ".pdf"
 On Error GoTo 0
 '******* Begin Send Email

 #If LateBinding = 0 Then
        Set miMail = appOL.CreateItem(olMailItem)  '*** olMailItem = 0 ***
 #Else
        Set miMail = appOL.CreateItem(0)
 #End If

        With miMail
            .To = rst![EMail]
            .Subject = "WPOA Annual Dues Statement: " & rst![OwnerLName]
            .Body = zMsgBody & "Bill" & Trim(Str(rst![OwnerID])) & _
                    " Owner: " & rst![OwnerLName]
            .ReadReceiptRequested = True
            zAttFN = zBillPath & "Bill" & _
                     Trim(Str(rst![OwnerID])) & ".pdf"
            Set oMyAttach = miMail.Attachments.Add(zAttFN)
            .Save
        End With   'miMail

        Set miMail = Nothing
        lBillCnt = lBillCnt + 1  '*** Count Emails Created ***

 '******* End Send Email

      End If
     
      rst.MoveNext        '*** Move to Next Record ***
   
    Loop Until rst.EOF
   
    MsgBox Format(lBillCnt, "#,###") & " Email Bills Created." & _
           vbCrLf & vbCrLf & _
           "Maximize Outlook and Press F8 and select the" & _
           "SendAllDrafts macro then click Run." & _
           vbCrLf & vbCrLf & _
           "If Outlook wasn't open when you created the Email" & _
           vbCrLf & "Bills you will have to move them to the" & _
           vbCrLf & "Drafts folder from the Inbox BEFORE you" & _
           vbCrLf & "run the macro!", vbOKOnly + vbInformation, _
           "Next Step:"
    GoTo GetOut

 WaitForPDFCreator:
    Select Case Err.Number
          Case 75
              Sleep 750  '*** Wait another 3/4 second. ***
              Resume Try_Again
          Case Else
              MsgBox "Module:" & vbTab & "BillingsCode" & vbCrLf & _
                     "Routine:" & vbTab & "EmailMailBills" & vbCrLf & _
                     "Error: " & Err.Number & " " & _
                     Err.Description, vbCritical + vbOKOnly, _
                     "Unexpected Error:"
              Resume GetOut
    End Select
   
 GetOut:
    Set rst = Nothing     '*** Close RecordSet ***
    Set oMyAttach = Nothing
    Set miMail = Nothing
    Set appOL = Nothing
   
    SwitchPrinters strDfltPrt
    Forms![Switchboard].Visible = True
   
 End Sub                   '*** EmailBills() ***

Hope this gives you some idea of where to start. Post back with any questions. :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Thanks Mate!

Will try it when I get home from Work.

Devious

Reply | Quote