Results 1 to 11 of 11
  1. #1
    jcc285 is offline Advanced Beginner
    Windows 7 64bit Access 2010 64bit
    Join Date
    Aug 2014
    Posts
    70

    Automating Outlook 2016 from Access 2016


    I have successfully sent an e-mail from an Access form to Outlook using the Function below, however, the .Send command only gets the e-mail to the Outlook outbox. I have to physically open Outlook which has 'Send immediately when connected' selected in order for the e-mail to actually be sent.

    I have been searching for a simple vba code method to force Outlook to actually send the messages i.e. something akin to Outlook's 'Send Receive All' without success.

    Can anyone offer any help please

    Code:
    Option Compare Database
    Option Explicit
    Public Function SendMail(sSubject, sMessage, sDefaultAddress, sAttachment As String) As Boolean
    On Error GoTo ErrorHandler
            
            Dim olApp As Object
            Dim olMail As Object
            Dim olRecipient As Object
            Dim olAttachment As Object
            Dim strSQL As String
            Dim strAddress As String
            Dim strPath As String
            Dim db As DAO.Database
            Dim rs As DAO.Recordset
            
            Const olMailItem = 0
            Const olTo = 1
            Const olBCC = 3
            Const olImportanceHigh = 2
        
            'Create the Outlook session.
            Set olApp = CreateObject("Outlook.Application")
            'Create the message.
            Set olMail = olApp.CreateItem(olMailItem)
            
            'Create path to location of any attachment
            strPath = "C:\Temp"
            'Define the recordset
            Set db = CurrentDb
            'Define field to be used for eMail recipients
            strAddress = "EMail"
            'Define SQL this is always the same source the calling form creates
            'tbl_Bulk_EMail from user defined parameters
            strSQL = "SELECT DISTINCT EMail FROM tbl_Bulk_EMail"
            'Open a recordset to obtain recipients
            Set rs = db.OpenRecordset(strSQL)
            With rs
             If Not .BOF And Not .EOF Then
              .MoveLast
              .MoveFirst
                intRecordCount = rs.RecordCount
                While (Not .EOF)
                 Set olRecipient = olMail.Recipients.Add(.Fields(strAddress))
                 olRecipient.Type = olBCC
                .MoveNext
                Wend
             End If
            End With
           'Add the Default address if present
             If sDefaultAddress > "" Then
              Set olRecipient = olMail.Recipients.Add(sDefaultAddress)
              olRecipient.Type = olTo
             End If
             
            With olMail
             'Set the Subject, Body, and Importance of the message.
              .Subject = sSubject
              .Body = sMessage
              .Importance = olImportanceHigh  'High importance
                'Add attachment if it exists
                 If sAttachment > "" Then
                  .Attachments.Add strPath & "\" & sAttachment & ".pdf"
                 End If
              ' Resolve each Recipient's name.
                For Each olRecipient In .Recipients
                    olRecipient.Resolve
                Next
                'Display the EMail for further edit
                 '.Display
                'Email can be sent without opportunity for further edit
                  .Send   '*******************************************************************?????
            End With
        
    'All OK so return True to the calling Form
    SendMail = True
    
    
    ExitFunction:
        Set olRecipient = Nothing
        Set olMail = Nothing
        Set olApp = Nothing
        Exit Function
    ErrorHandler:
        SendMail = False
        Resume ExitFunction
    End Function

  2. #2
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    50,076
    Wish I could but cannot replicate issue. My email is sent.
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  3. #3
    jcc285 is offline Advanced Beginner
    Windows 7 64bit Access 2010 64bit
    Join Date
    Aug 2014
    Posts
    70
    Quote Originally Posted by June7 View Post
    Wish I could but cannot replicate issue. My email is sent.
    OK, thanks for replying. I noted that you are using Access 2010 and I am wondering if my problem is peculiar to 2016.

    I'll continue searching for a resolution.

  4. #4
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    50,076
    Your profile also says using 2010. Might want to update.

    I decided to test your code and get the same result as with mine - email sends without pause. Can't find anything saying 2016 should perform any different.
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  5. #5
    jcc285 is offline Advanced Beginner
    Windows 7 64bit Access 2016
    Join Date
    Aug 2014
    Posts
    70
    Thank you for doing that at least I know I don't have coding issues. it must be my Outlook but I have no idea how to stop this. I switched the default outlook account today from an IMAP account to a POP account but that made no difference. My messages go to my outbox and sit there until I open Outlook. Most annoying!!
    i did notice the profile issue and changed it this morning
    again many thanks

  6. #6
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    50,076
    Realized my Outlook is always open so I closed it then ran the code. I get a warning pop "A program is trying to send an email on your behalf ...". Reopened Outlook and now I keep getting that popup. Rats! How did I get rid of that before?!?!?!?

    Had to update virus definitions. No more popup.
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  7. #7
    jcc285 is offline Advanced Beginner
    Windows 7 64bit Access 2016
    Join Date
    Aug 2014
    Posts
    70
    Quote Originally Posted by June7 View Post
    Realized my Outlook is always open so I closed it then ran the code. I get a warning pop "A program is trying to send an email on your behalf ...". Reopened Outlook and now I keep getting that popup. Rats! How did I get rid of that before?!?!?!?

    Had to update virus definitions. No more popup.
    Yes, I logged in this morning to reply but see you have solved the Outlook Security Warning.
    I thought it worthwhile to post how to check if out of date virus definitions is the cause of the problem.

    Do Outlook>File>Options>Trust Centre>Trust Centre Settings>Programmatic Access
    There it should say 'Anti Virus status: Active'
    If it says anything else you need to update your AV.

    Dare I ask?? have you retried sending the e-mail??

  8. #8
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    50,076
    Yes. Sends email whether Outlook is open or closed.

    For some reason Programmatic Access Security settings are grayed out and not available so permanently set on 'Warn me'.
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  9. #9
    jcc285 is offline Advanced Beginner
    Windows 7 64bit Access 2016
    Join Date
    Aug 2014
    Posts
    70
    Quote Originally Posted by June7 View Post
    Yes. Sends email whether Outlook is open or closed.

    For some reason Programmatic Access Security settings are grayed out and not available so permanently set on 'Warn me'.
    OK, well I'm still stuck, my e-mails go to the Outbox and sit there until I start Outlook. Have checked my AV (Norton) it was checking outgoing mail, switching that off makes no difference.

    Apparently, the greyed out options are 'Normal' if 'Anti Virus status: Valid' is true. See https://answers.microsoft.com/en-us/...54273e7?auth=1

    Thanks for all your help, regrettably, I am no nearer a solution.

  10. #10
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    50,076
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  11. #11
    jcc285 is offline Advanced Beginner
    Windows 7 64bit Access 2016
    Join Date
    Aug 2014
    Posts
    70
    Quote Originally Posted by June7 View Post
    I found this after much searching
    https://www.mrexcel.com/forum/excel-...n-outlook.html
    I have 'stolen' the bits of code that force the save
    Code:
    OptionCompare Database
    OptionExplicit
    PublicFunction SendMail(sDefaultAddress, sSubject, sMessage, sAttachment As String)As Boolean
    On ErrorGoTo ErrorHandler        
    Dim olApp AsObject
    Dim olMailAs Object
    DimolRecipient As Object
    DimolAttachment As Object
    Dim objNsp As Object
    Dim colSyc As Object
    Dim objSyc As Object
    Dim i As Integer
    Dim strSQLAs String
    DimstrAddress As String
    Dim db AsDAO.Database
    Dim rs AsDAO.Recordset
    
     Const olMailItem = 0
     Const olTo = 1
     Const olBCC = 3
     Const olImportanceHigh = 2
    
      'Create the Outlook session.
       Set olApp =CreateObject("Outlook.Application")
      'Create the message.
       Set olMail = olApp.CreateItem(olMailItem)
      'Define the Sycobjects
        Set objNsp =olApp.Application.GetNamespace("MAPI")
        Set colSyc =objNsp.SyncObjects
      'Define the recordset
        Set db = CurrentDb
        'Define field to be used for eMailrecipients
         strAddress = "EMail"
        'Define SQL this is always the same sourcethe calling form creates
        'tbl_Bulk_EMail from user definedparameters
          strSQL = "SELECT DISTINCT EMail FROMtbl_Bulk_EMail"
          'Open a recordset to obtain recipients
            Set rs = db.OpenRecordset(strSQL)
            With rs
             If Not .BOF And Not .EOF Then
              .MoveLast
              .MoveFirst
                intRecordCount = rs.RecordCount
                While (Not .EOF)
                 Set olRecipient =olMail.Recipients.Add(.Fields(strAddress))
                 olRecipient.Type = olBCC
                .MoveNext
                Wend
             End If
            End With
    
        'Add the Default address if present
          If sDefaultAddress > "" Then
           Set olRecipient =olMail.Recipients.Add(sDefaultAddress)
            olRecipient.Type = olTo
          End If
    
         With olMail
         'Set the Subject, Body, and Importance ofthe message.
          .Subject = sSubject
          .Body = sMessage
          .Importance = olImportanceHigh  'High importance
    
            'Add attachment if it exists
              If sAttachment > "" Then
               .Attachments.Add sAttachment
              End If        
            'Resolve each Recipient's name.
              For Each olRecipient In .Recipients
                olRecipient.Resolve
              Next
                'Display the EMail for further edit
                 '.Display
                'Email can be sent withoutopportunity for further edit
             .Send
            End With
    'Force Outlook toSync items
       For i = 1 TocolSyc.Count
        Set objSyc =colSyc.Item(i)
        objSyc.Start
       Next
    'All OK soreturn True to the calling Form
    SendMail =True
    ExitFunction:
        Set olRecipient = Nothing
        Set olMail = Nothing
        Set olApp = Nothing
        Set colSyc = Nothing
        Set objSyc = Nothing
        Exit Function
    ErrorHandler:
        SendMail = False
        Resume ExitFunction
    End Function
    This works perfectly !!!!!!!!!!!!!!!!!! What a struggle !!!!!!!!!!!!!
    Thanks to all who have offered help

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 6
    Last Post: 07-28-2017, 09:07 AM
  2. Replies: 1
    Last Post: 12-20-2016, 10:09 PM
  3. Outlook 2016 not launching with code
    By dave4 in forum Access
    Replies: 2
    Last Post: 06-22-2016, 12:09 PM
  4. Replies: 3
    Last Post: 04-21-2016, 06:20 AM
  5. Automating Outlook from Access
    By RMittelman in forum Programming
    Replies: 8
    Last Post: 09-23-2011, 09:30 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums - Senior Forums