Results 1 to 3 of 3
  1. #1
    2 Star Lounger
    Join Date
    Jun 2003
    Location
    New Jersey
    Posts
    103
    Thanks
    6
    Thanked 0 Times in 0 Posts

    How to send Access forms through Outlook email?

    Hi,

    I have an access database with a compensation statement for each employee. I need to send the statement to each employee via outlook email. I can PDF them but how do I send each one out individually?

    Please help. Thank you.
    Corden

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Corden,

    Here's the code I use to do this with our annual HOA dues statements.
    Code:
    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
       
       If Not SetDateForBills() Then
         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 0.75  '*** 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
       
    End Sub                   '*** EmailBills() ***
    Note: The compiler directives (#) allow you to code & debug w/intellisense help when the compiler variable LateBinding is set to 0 (requires references to be set for the project) and for the production version set LateBinding to 1 so no references are required which makes the code portable across version of office and different machines.

    HTH
    Last edited by RetiredGeek; 2015-07-07 at 08:18.
    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:

    Corden (2015-07-07)

  4. #3
    2 Star Lounger
    Join Date
    Jun 2003
    Location
    New Jersey
    Posts
    103
    Thanks
    6
    Thanked 0 Times in 0 Posts
    Thank you very much! I will give this a try!

Posting Permissions

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