Results 1 to 3 of 3
  1. #1
    2 Star Lounger
    Join Date
    Feb 2002
    Location
    Blacktown, Sydney, New South Wales, Australia
    Posts
    175
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Report from Access 2010 to E-Mail

    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

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    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.
    Last edited by RetiredGeek; 2012-05-26 at 12:36.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. The Following User Says Thank You to RetiredGeek For This Useful Post:

    Devious Dude (2012-02-20)

  4. #3
    2 Star Lounger
    Join Date
    Feb 2002
    Location
    Blacktown, Sydney, New South Wales, Australia
    Posts
    175
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Thanks Mate!

    Will try it when I get home from Work.

    Devious

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •