Problems sending outlook emails through Access (1 Viewer)

Zedster

Registered User.
Local time
Today, 21:03
Joined
Jul 2, 2019
Messages
105
In all vba routines/functions I include error trapping that sends me an email with error details whenever a user encounters an error. I use this to get feedback from users to continuously improve the database.

I have done this for some time without there being any issues. But last week I started to receive an error message from outlook whenever Access tried to send an email. The message went along the lines "A program is trying to access email address information stored in outlook...." It asks the user to allow or deny with the deny option highlighted.

Does anyone know a work around? Our IT department does not want to globally turn these warnings off. Is it possible to create an exception for Access?
 

theDBguy

I’m here to help
Staff member
Local time
Today, 13:03
Joined
Oct 29, 2018
Messages
13,184
Hi. Which version of Outlook are you using? There are third-party apps for handling this. Check out Redemption and ClickYes.
 

Micron

AWF VIP
Local time
Today, 16:03
Joined
Oct 20, 2018
Messages
3,471
Outlook checks your anti virus status. If yours is out of date, it might cause the prompt so I'd start there. The reason the older version works is likely due to the changes that were made to security protocols between that version and later versions of Office. You could also use CDO to send email without getting that prompt - unless that has changed too.
 

Isaac

Lifelong Learner
Local time
Today, 13:03
Joined
Mar 14, 2017
Messages
2,700
I agree - the changing policies in the Office (outlook) versions have been a little confusing.
In earlier versions, you could permanently disable that with a Trust Center setting. A quick training moment with clients could solve that.
In later versions, the average end user client cannot necessarily disable that, but, it usually doesn't show up as long as Outlook "thinks" that your anti virus software is up to date. I have worked at companies where Outlook "thought" that their AV software was out of date the whole time I worked there. And outlook automation (without involving the end user) simply wasn't possible. Of course, in most corporate environments installing the workaround software isn't possible. But if it is, I second dbguy's suggestion on Redemption. I've used it once and it did work. If your corporate IT department allows this install you are very lucky!

Big picture additional options. These may be outside the realm of possibility, but I would suggest looking into them thoroughly just in case. If you could implement them, they would be an overall "gain" in the sophistication and reliability of your error handling process anyway:
If you have access to either SSIS or SSRS, or can convince an internal group to utilize them, then you could use Access to insert error information into a database table. Then use either SSRS (with an email subscription) or SSIS (with a routine check against the error table + a Send Mail task) to send you this information. Getting to either one of these points would be very well worth it, if possible.

One last note. I think that the Outlook security message will differ, in terms of whether it does or doesn't pop up, depending on precisely what you DO with the Outlook object model. For example, if I remember right, creating a mailitem and choosing to .Display it instead of .Send it, might avoid the security prompt. Obviously this isn't 100% of what you wanted, but just another thought that may or may not help.
 
Last edited:

James Dickinson

PigeonPie
Local time
Tomorrow, 10:03
Joined
May 10, 2018
Messages
37
build a web function in azure that receives a post from access. set up a free send grid account and use their api to send an email to you. you get like 100 free emails per day through sendgrid. then you wont need outlook at all. done this many times. also what about a cloud SQL table that stores all the errors instead of email?
 

Zedster

Registered User.
Local time
Today, 21:03
Joined
Jul 2, 2019
Messages
105
Outlook checks your anti virus status. If yours is out of date, it might cause the prompt so I'd start there. The reason the older version works is likely due to the changes that were made to security protocols between that version and later versions of Office. You could also use CDO to send email without getting that prompt - unless that has changed too.
Thanks, what is CDO?
 

Zedster

Registered User.
Local time
Today, 21:03
Joined
Jul 2, 2019
Messages
105
build a web function in azure that receives a post from access. set up a free send grid account and use their api to send an email to you. you get like 100 free emails per day through sendgrid. then you wont need outlook at all. done this many times. also what about a cloud SQL table that stores all the errors instead of email?
I don't have access to Azure unfortunately.
 

Zedster

Registered User.
Local time
Today, 21:03
Joined
Jul 2, 2019
Messages
105
I agree - the changing policies in the Office (outlook) versions have been a little confusing.
In earlier versions, you could permanently disable that with a Trust Center setting. A quick training moment with clients could solve that.
In later versions, the average end user client cannot necessarily disable that, but, it usually doesn't show up as long as Outlook "thinks" that your anti virus software is up to date. I have worked at companies where Outlook "thought" that their AV software was out of date the whole time I worked there. And outlook automation (without involving the end user) simply wasn't possible. Of course, in most corporate environments installing the workaround software isn't possible. But if it is, I second dbguy's suggestion on Redemption. I've used it once and it did work. If your corporate IT department allows this install you are very lucky!

Big picture additional options. These may be outside the realm of possibility, but I would suggest looking into them thoroughly just in case. If you could implement them, they would be an overall "gain" in the sophistication and reliability of your error handling process anyway:
If you have access to either SSIS or SSRS, or can convince an internal group to utilize them, then you could use Access to insert error information into a database table. Then use either SSRS (with an email subscription) or SSIS (with a routine check against the error table + a Send Mail task) to send you this information. Getting to either one of these points would be very well worth it, if possible.

One last note. I think that the Outlook security message will differ, in terms of whether it does or doesn't pop up, depending on precisely what you DO with the Outlook object model. For example, if I remember right, creating a mailitem and choosing to .Display it instead of .Send it, might avoid the security prompt. Obviously this isn't 100% of what you wanted, but just another thought that may or may not help.

I don't appear to have SSIS or SSRS. Historically I have always written error messages to a text file located on a shared & mapped company drive. But most of us have been working from home for the last 12 weeks and what is happening is some users are not mapped to the drive so I do not get an error log. I also have a problem that the SQL server connection appears weak since working from home and many of the database issues users are getting I believe could stem from network connection problems, hence the idea of sending an email with the error details. I assume if it is a server connection issue SSIS & SSRS wouldn't work, but I don't have much familiarity with these services.

Regarding redemption, I assume this would need to be installed on all users machines? Our corporate IT department tend to be very cautious and may not support this option.
 

isladogs

CID VIP
Local time
Today, 21:03
Joined
Jan 14, 2017
Messages
14,016
As I was just replying, I'll post this for info.
CDO = collaborative data objects. It is a method of sending emails direct from Access without using an external program such as Outlook. I have used CDO as my main method of sending emails for over 15 years and it works well.
There is an example app at this link if you want to try it http://www.mendipdatasystems.co.uk/email-tester/4594365455
 

James Dickinson

PigeonPie
Local time
Tomorrow, 10:03
Joined
May 10, 2018
Messages
37
I needed this functionality anyway so I wrote it up just now. It works, you may need to go into your gmail settings and allow the app but i left a note how to do that at the bottom of the SendEmail Function

Paste this into any Module
Code:
Public Sub CatchError()
Dim MailOrLog As New Gmail

MailOrLog.TrySend
Set MailOrLog = Nothing
End Sub

Create a new class called Gmail and paste this...
Code:
Option Compare Database
Option Explicit

Private Type GmailCred
    sendusername As String
    sendpassword As String
End Type


Private Type MailObject
    To As String
    From As String
    Subject As String
    Body As String
    CC As String
    BC As String
End Type

Private MailDetails As MailObject
Private GmailAccount As GmailCred

Private Sub Class_Initialize()

    GmailAccount.sendusername = "YOUR GMAIL ACCOUNT@gmail.com"
    GmailAccount.sendpassword = "YOUR GMAIL PASSWORD"
    
    MailDetails.To = "ADMIN AT YOUR COMPANY @gmail.com"
    MailDetails.From = GmailAccount.sendusername
    MailDetails.Subject = "My App had an Error"
    MailDetails.Body = "Error Line: " & Erl & vbNewLine & "" _
                        & "Error Number: " & err.Number & vbNewLine & "" _
                        & "Error Description: " & err.Description & vbNewLine & "" _
                        & "Error Source: " & err.Source & vbNewLine & "" _
                        & "Error Time: " & Now() & vbNewLine & "" _
                        & "User : WhoEverIsLoggedIntoApp" & vbNewLine & "" _
                        & "Machine: " & Environ("ComputerName") & vbNewLine & "" _
                        & "AppVer: YOUR CURRENT APP VERSION THAT YOU DEFINE" & vbNewLine & "" _
                        & "AccessVer: " & Application.Version & "( Build: " & Application.Build & ")"
    MailDetails.CC = ""
    MailDetails.BC = ""
    
    

End Sub

Public Sub TrySend()
    If Not SendEmail Then
        LogError
        DumpToErrorFile
    End If
End Sub


Private Function SendEmail(Optional FilePathAttachment As String) As Boolean

On Error GoTo err
        Dim msg As Object
        
        Set msg = CreateObject("CDO.Message")
        
        msg.From = MailDetails.From
        msg.To = MailDetails.To
        msg.Subject = MailDetails.Subject
        msg.TextBody = MailDetails.Body
        msg.CC = MailDetails.CC
        msg.bcc = MailDetails.BC
        msg.replyto = MailDetails.From

        'Optionally add many files to the email
        If Nz(FilePathAttachment, "") <> "" Then
             msg.addattachment "file://" & FilePathAttachment & ""
        End If
        
'        If IsNull(Me.Attachment2) = False Then
'             Dim strAttachment2 As String
'             strAttachment2 = Me.Attachment2
'             msg.addattachment "file://" & strAttachment2 & ""
'        End If
'        If IsNull(Me.Attachment3) = False Then
'             Dim strAttachment3 As String
'             strAttachment3 = Me.Attachment3
'             msg.addattachment "file://" & strAttachment3 & ""
'        End If

        'Now send it
        msg.configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        msg.configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        msg.configuration.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        msg.configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = GmailAccount.sendusername
        msg.configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = GmailAccount.sendpassword
        msg.configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        msg.configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        
        msg.configuration.Fields.Update
        msg.Send
        
        'Possible errors
        'Error Code : 0x80040217
        '-Cause : Your Google account needs to allow the Access App to send the mail. To do this go to
        'https://myaccount.google.com/security
        'Scroll down and turn on ("Less secure app access")
        'try sending again
exithere:
   SendEmail = True
   Exit Function
err:
   SendEmail = False
    
End Function

Private Sub LogError()

    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("Log")
    
    rs.AddNew
        rs!ErrNo = err.Number
        rs!ErrLine = Erl
        rs!ErrDescription = err.Description
        rs!ErrSource = err.Source
        rs!CurrentUser = "WhoEverIsLoggedIntoApp"
        rs!Machine = Environ("ComputerName")
        rs!AppVer = "YOUR CURRENT APP VERSION THAT YOU DEFINE"
        rs!AccessVer = "Access: " & Application.Version & "( Build: " & Application.Build & ")"
        rs!TimeStamp = Now()
        'Other things could be file paths to error files
        'Other Forms/reports that are open at error time
        'Error could be a SQL error so is a part of dbengine.errors collection
        
    rs.Update
    
    rs.Close
    Set rs = Nothing
    
End Sub

Private Sub DumpToErrorFile()
    Dim filePath As String
    Dim iFileNumber As Integer
    Dim fso As Object
    Dim sFile As Object
    
    filePath = CurrentProject.Path & "\ErrorLog.txt"

    ' The advantage of correctly typing fso as FileSystemObject is to make autocompletion
    ' (Intellisense) work, which helps you avoid typos and lets you discover other useful
    ' methods of the FileSystemObject
    
    Set fso = CreateObject("Scripting.FileSystemObject")

    If Dir(filePath) = "" Then
        Set sFile = fso.CreateTextFile(filePath)
        sFile.Close
        Set sFile = Nothing
    End If
    
    iFileNumber = FreeFile                      ' Get unused file number
    Open filePath For Append As #iFileNumber    ' Connect to the file
        
    Print #iFileNumber, Now() & " ErrNo:(" & err.Number & ") ErrLine:(" & Erl & ") ErrDesc:'" & err.Description & "' ErrSource:'" & err.Source & "'"                ' Append our string
    Close #iFileNumber                       ' Close the file
    
    
    Set fso = Nothing


End Sub
 

theDBguy

I’m here to help
Staff member
Local time
Today, 13:03
Joined
Oct 29, 2018
Messages
13,184
I needed this functionality anyway so I wrote it up just now. It works, you may need to go into your gmail settings and allow the app but i left a note how to do that at the bottom of the SendEmail Function

Paste this into any Module
Code:
Public Sub CatchError()
Dim MailOrLog As New Gmail

MailOrLog.TrySend
Set MailOrLog = Nothing
End Sub

Create a new class called Gmail and paste this...
Code:
Option Compare Database
Option Explicit

Private Type GmailCred
    sendusername As String
    sendpassword As String
End Type


Private Type MailObject
    To As String
    From As String
    Subject As String
    Body As String
    CC As String
    BC As String
End Type

Private MailDetails As MailObject
Private GmailAccount As GmailCred

Private Sub Class_Initialize()

    GmailAccount.sendusername = "YOUR GMAIL ACCOUNT@gmail.com"
    GmailAccount.sendpassword = "YOUR GMAIL PASSWORD"
   
    MailDetails.To = "ADMIN AT YOUR COMPANY @gmail.com"
    MailDetails.From = GmailAccount.sendusername
    MailDetails.Subject = "My App had an Error"
    MailDetails.Body = "Error Line: " & Erl & vbNewLine & "" _
                        & "Error Number: " & err.Number & vbNewLine & "" _
                        & "Error Description: " & err.Description & vbNewLine & "" _
                        & "Error Source: " & err.Source & vbNewLine & "" _
                        & "Error Time: " & Now() & vbNewLine & "" _
                        & "User : WhoEverIsLoggedIntoApp" & vbNewLine & "" _
                        & "Machine: " & Environ("ComputerName") & vbNewLine & "" _
                        & "AppVer: YOUR CURRENT APP VERSION THAT YOU DEFINE" & vbNewLine & "" _
                        & "AccessVer: " & Application.Version & "( Build: " & Application.Build & ")"
    MailDetails.CC = ""
    MailDetails.BC = ""
   
   

End Sub

Public Sub TrySend()
    If Not SendEmail Then
        LogError
        DumpToErrorFile
    End If
End Sub


Private Function SendEmail(Optional FilePathAttachment As String) As Boolean

On Error GoTo err
        Dim msg As Object
       
        Set msg = CreateObject("CDO.Message")
       
        msg.From = MailDetails.From
        msg.To = MailDetails.To
        msg.Subject = MailDetails.Subject
        msg.TextBody = MailDetails.Body
        msg.CC = MailDetails.CC
        msg.bcc = MailDetails.BC
        msg.replyto = MailDetails.From

        'Optionally add many files to the email
        If Nz(FilePathAttachment, "") <> "" Then
             msg.addattachment "file://" & FilePathAttachment & ""
        End If
       
'        If IsNull(Me.Attachment2) = False Then
'             Dim strAttachment2 As String
'             strAttachment2 = Me.Attachment2
'             msg.addattachment "file://" & strAttachment2 & ""
'        End If
'        If IsNull(Me.Attachment3) = False Then
'             Dim strAttachment3 As String
'             strAttachment3 = Me.Attachment3
'             msg.addattachment "file://" & strAttachment3 & ""
'        End If

        'Now send it
        msg.configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        msg.configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        msg.configuration.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        msg.configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = GmailAccount.sendusername
        msg.configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = GmailAccount.sendpassword
        msg.configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        msg.configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
       
        msg.configuration.Fields.Update
        msg.Send
       
        'Possible errors
        'Error Code : 0x80040217
        '-Cause : Your Google account needs to allow the Access App to send the mail. To do this go to
        'https://myaccount.google.com/security
        'Scroll down and turn on ("Less secure app access")
        'try sending again
exithere:
   SendEmail = True
   Exit Function
err:
   SendEmail = False
   
End Function

Private Sub LogError()

    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("Log")
   
    rs.AddNew
        rs!ErrNo = err.Number
        rs!ErrLine = Erl
        rs!ErrDescription = err.Description
        rs!ErrSource = err.Source
        rs!CurrentUser = "WhoEverIsLoggedIntoApp"
        rs!Machine = Environ("ComputerName")
        rs!AppVer = "YOUR CURRENT APP VERSION THAT YOU DEFINE"
        rs!AccessVer = "Access: " & Application.Version & "( Build: " & Application.Build & ")"
        rs!TimeStamp = Now()
        'Other things could be file paths to error files
        'Other Forms/reports that are open at error time
        'Error could be a SQL error so is a part of dbengine.errors collection
       
    rs.Update
   
    rs.Close
    Set rs = Nothing
   
End Sub

Private Sub DumpToErrorFile()
    Dim filePath As String
    Dim iFileNumber As Integer
    Dim fso As Object
    Dim sFile As Object
   
    filePath = CurrentProject.Path & "\ErrorLog.txt"

    ' The advantage of correctly typing fso as FileSystemObject is to make autocompletion
    ' (Intellisense) work, which helps you avoid typos and lets you discover other useful
    ' methods of the FileSystemObject
   
    Set fso = CreateObject("Scripting.FileSystemObject")

    If Dir(filePath) = "" Then
        Set sFile = fso.CreateTextFile(filePath)
        sFile.Close
        Set sFile = Nothing
    End If
   
    iFileNumber = FreeFile                      ' Get unused file number
    Open filePath For Append As #iFileNumber    ' Connect to the file
       
    Print #iFileNumber, Now() & " ErrNo:(" & err.Number & ") ErrLine:(" & Erl & ") ErrDesc:'" & err.Description & "' ErrSource:'" & err.Source & "'"                ' Append our string
    Close #iFileNumber                       ' Close the file
   
   
    Set fso = Nothing


End Sub
That is good to know (re: less secure apps). A while back, I thought Google discontinued it, in favor of OAuth2. It might be worth noting though that this is not available if you enable two-factor authentication (2FA) on your Google account. Cheers!
 

Isaac

Lifelong Learner
Local time
Today, 13:03
Joined
Mar 14, 2017
Messages
2,700
what is happening is some users are not mapped to the drive so I do not get an error log
Then use the full UNC path. Better to usually not use mapped drives in your apps anyway for this precise reason.
(Unless in rare cases that you are mapping a drive [with credentials] on the fly, and then disconnecting it, in code, in which case it can be very handy).

Don't worry answering just established it is part of redemption
As Isla Dogs pointed out, CDO is a general method for sending emails--not part of Redemption (although I'm not saying Redemption doesn't happen to involve CDO somehow, I have no idea whether they utilize it. I wouldn't think so as Redemption has to do with bypassing Outlook security settings). CDO is great if you're in an environment where you have an open SMTP service you can drop mails to, or to leverage things like Gmail (as pointed out, they keep going back and forth but seem to be going generally towards discontinuing this option soon).
 

Users who are viewing this thread

Top Bottom