Bypassing Access warning messages

dbDamo

Registered User.
Local time
Today, 09:39
Joined
May 15, 2009
Messages
395
Hi

I have macros attached to command buttons that run a selection of Delete and Append queries before an export is performed. I was wondering if there is a way to bypass the Access warning messages while selecting the positive action 'Yes'?

I also have another command button that sends numerous automated emails to different recipients based on the results of a set of queries. I would also like to bypass the Access warning messages for sending these emails if possible.

There are only three people that can perform these actions as the command buttons are password protected, and they are members of my team whom I had assumed were capable of pressing 'Yes' 10 times. However, having looked at the figures they have sent out this week it seems I was wrong with my assumptions and need a way to safeguard against any future errors.

Any help appreciated!!
 
To cancel warning messages wrap

DoCmd.SetWarnings False


DCmd.SetWarnings True

around your code.

David
 
A nice simple solution, just what I was after!!

Thank you very much

EDIT - works nicely for the queries, but does not work for the email, still get the 'A program is trying to send an email on your behalf etc' error - any ideas?
 
This email notification is not Access bourne it comes from Outlook. However there is a fix for this. Do search on this topic for the solution.

David
 
I have searched for hours now and have only found vb code solutions for Outlook 2003 onwards, I use Outlook 2002.

There are other ways around it by using 3rd party apps or using SMTP, neither of which are an option for me.

Any ideas???
 
You can use CDO. IT works quite well. You will have to install this feature as a windows component which is only availabe on XP PRO.

Code:
Private Sub EmailStatus(MySMTPServer As String, MyFromAddress As String, MyToAddress As Variant, MySubjectLine As String, MyMessageText As String, blnErrorFound As Boolean)

      Dim objMessage As Variant
      Dim cdoConfig As Variant
      Dim sch As String

      If MyToAddress = "" Then Exit Sub

      'Set up cdo Configurations
      sch = "http://schemas.microsoft.com/cdo/configuration/"

      Set cdoConfig = CreateObject("CDO.Configuration")

      With cdoConfig.Fields
          .Item(sch & "sendusing") = 2 ' cdoSendUsingPort
          .Item(sch & "smtpserver") = MySMTPServer
          .Update
      End With


      'Creates CDO mail object

      Set objMessage = CreateObject("CDO.Message")
      Set objMessage.Configuration = cdoConfig

      objMessage.Subject = MySubjectLine

      objMessage.From = MyFromAddress 'Constant

      objMessage.To = MyToAddress
      
      
      'Email me only if there is a problem
      If blnErrorFound Then
            objMessage.CC = "admin@mail.com"
      End If
      

      objMessage.TextBody = MyMessageText

      'objMessage.AddAttachment "c:\" & MyReportFile

      objMessage.Send

      Set objMessage = Nothing
      Set cdoConfig = Nothing


End Sub
 
thanks ions, will give it a go Tomorrow

EDIT - have installed CDO but am having difficulty manipulating my code to incorporate the changes. Here is the code I am currently using:-

Code:
Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Dim sToName As String
Dim sSubject As String
Dim sMessageBody As String
 
Set MyDb = CurrentDb()
Set rsEmail = MyDb.OpenRecordset("6g Daily Email Query", dbOpenSnapshot)
 
With rsEmail
        .MoveFirst
        Do Until rsEmail.EOF
            If IsNull(.Fields(0)) = False Then
                sToName = .Fields(0)
                sSubject = "Todays Testing for " & .Fields(1)
                sMessageBody = "Below is a listing of testing work for you Today. If you need a detailed listing of tests, please contact the Testing Team who will provide this.  " & vbCrLf & _
                    "Number of Tests Due to Complete Today: " & .Fields(2) & vbCrLf & _
                    "Number of Tests Due to Start Today: " & .Fields(3) & vbCrLf & _
                    "Number of Tests Past Planned Completion Date: " & .Fields(4) & vbCrLf & _
                    "Number of Tests Past Planned Start Date: " & .Fields(5) & vbCrLf & _
                    "Number of Tests Due to Start Tomorrow Prep Not Complete: " & .Fields(6)
                DoCmd.SendObject acSendNoObject, , , _
                    sToName, , , sSubject, sMessageBody, False, False
            End If
            .MoveNext
        Loop
End With
 
Set MyDb = Nothing
Set rsEmail = Nothing
ErrorHandlerExit:
    Exit Sub
ErrorHandler:
    If Err = 3021 Then
     MsgBox "There are no emails to send"
     End If

Any help greatly appreciated!!
 
Last edited:
Still need help incorporating my code into this new CDO code but have just realised how dangerous (or fun!!) using this code can be.

For example I have just been able to set the Senders email address to that of my General Manager and send an email to my colleague informing them that their services are no longer required and their contract will be terminated at the end of their current term.

So when she opened the email she thought it was from the general manager. Even better is that the email is not copied into the 'senders' sent items and when the recipient hits reply the email is sent to that email address.

Am going to have lots of fun with this!!

Just thought I'd share, and thanks in advance for helping me write my new code.
 
Thats a nasty prank.

Is she still a friend?
 
I told her to check her email so she knew I had been up to something.

I am going to send a site email when the General Manager goes home telling everyone that Tomorrow is a casual day, should be funny.

Anyway, back to the serious stuff. This code is doing my head in. Have tried everything I can think of and cannot get it to work. I can bypass the Outlook when I use your simple code, but when I try to use a recordset as the source for email address, body of text etc it all goes down the pan.
 
Here is my attempt at modifying the code:-

Code:
Private Sub Command13_Click()
On Error GoTo ErrorHandler
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("6g Daily Email Query", dbOpenSnapshot)
Set objCDOMessage = CreateObject("CDO.Message")
With objCDOMessage
Set .Configuration = objCDOConfig
Do Until rs.EOF
objMessage.Sender = "[EMAIL="bwbsl.testing@bwbsl.co.uk"]bwbsl.testing@bwbsl.co.uk[/EMAIL]"
objMessage.To = rs!Email_Address
objMessage.Subject = "Todays testing for " & rs!Tester
objMessage.TextBody = "Below is a listing of testing work for you Today. If you need a detailed listing of tests, please contact the Testing Team who will provide this.  " & vbCrLf & _
                    "Number of Tests Due to Complete Today: " & rs!Complete_Today & vbCrLf & _
                    "Number of Tests Due to Start Today: " & rs!Start_Today & vbCrLf & _
                    "Number of Tests Past Planned Completion Date: " & rs!Past_Comp_Date & vbCrLf & _
                    "Number of Tests Past Planned Start Date: " & rs!Past_Start_Date & vbCrLf & _
                    "Number of Tests Due to Start Tomorrow Prep Not Complete: " & rs!Prep_Not_Done
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/sendusing[/URL]") = 2
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserver[/URL]") = "smtp.server.com"
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserverport[/URL]") = 25
objMessage.Configuration.Fields.Update
.MoveNext
Loop
rs.Close
Set rs = Nothing
ErrorHandlerExit:
    Exit Sub
ErrorHandler:
    If Err = 3021 Then
     MsgBox "There are no emails to send"
     End If
  
    
End With
End Sub

Anything stand out?
 
Not really.

However I don't see a objMessage.Send
 
Yep, that code was missing the objMessage.Send, have added it but still not working.
 
Code:
objMessage.To = rs!Email_Address
objMessage.Subject = "Todays testing for " & rs!Tester
objMessage.TextBody = "Below is a listing of testing work for you Today. If you need a detailed listing of tests, please contact the Testing Team who will provide this.  " & vbCrLf & _
                    "Number of Tests Due to Complete Today: " & rs!Complete_Today & vbCrLf & _
                    "Number of Tests Due to Start Today: " & rs!Start_Today & vbCrLf & _
                    "Number of Tests Past Planned Completion Date: " & rs!Past_Comp_Date & vbCrLf & _
                    "Number of Tests Past Planned Start Date: " & rs!Past_Start_Date & vbCrLf & _
                    "Number of Tests Due to Start Tomorrow Prep Not Complete: " & rs!Prep_Not_Done

If you declare some string variables at the top of the code and pass the string to the variables and use the variables for the TextBody

Example

Dim StrTextBody As String

Code:
StrTextBody = "Below is a listing of testing work for you Today. If you need a detailed listing of tests, please contact the Testing Team who will provide this.  " & vbCrLf & _
                    "Number of Tests Due to Complete Today: " & rs!Complete_Today & vbCrLf & _
                    "Number of Tests Due to Start Today: " & rs!Start_Today & vbCrLf & _
                    "Number of Tests Past Planned Completion Date: " & rs!Past_Comp_Date & vbCrLf & _
                    "Number of Tests Past Planned Start Date: " & rs!Past_Start_Date & vbCrLf & _
                    "Number of Tests Due to Start Tomorrow Prep Not Complete: " & rs!Prep_Not_Done

Code:
objMessage.Subject = StrTextBody

Might work this way.

David
 
Spent a long time playing around and finally have some working code -

Code:
Private Sub Command13_Click()
On Error GoTo ErrorHandler
Dim mydb As DAO.Database
Dim rs As DAO.Recordset
Set mydb = CurrentDb()
Set rs = mydb.OpenRecordset("6g daily email query", dbOpenSnapshot)
With rs
.MoveFirst
Do Until rs.EOF
If IsNull(rs.Fields(0)) = False Then
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Todays Testing for " & rs.Fields(1)
objMessage.Sender = "[EMAIL="bwbsl.testing@bwbsl.co.uk"]bwbsl.testing@bwbsl.co.uk[/EMAIL]"
objMessage.To = rs.Fields(0)
objMessage.TextBody = "Below is a listing of testing work for you Today. If you need a detailed listing of tests, please contact the Testing Team who will provide this.  " & vbCrLf & _
                    "Number of Tests Due to Complete Today: " & rs.Fields(2) & vbCrLf & _
                    "Number of Tests Due to Start Today: " & rs.Fields(3) & vbCrLf & _
                    "Number of Tests Past Planned Completion Date: " & rs.Fields(4) & vbCrLf & _
                    "Number of Tests Past Planned Start Date: " & rs.Fields(5) & vbCrLf & _
                    "Number of Tests Due to Start Tomorrow Prep Not Complete: " & rs.Fields(6)
 
 
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/sendusing[/URL]") = 2
 
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserver[/URL]") = "smtp.server.com"
 
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserverport[/URL]") = 25
objMessage.Configuration.Fields.Update
 
objMessage.Send
End If
.MoveNext
Loop
rs.Close
Set rs = Nothing
ErrorHandlerExit:
    Exit Sub
ErrorHandler:
    If Err = 3021 Then
        MsgBox "There are no emails to send"
End If
End With
End Sub

So a couple of things I had missed included referencing the current Database for the recordset and when referencing fields from a query I had to use "." and not "!"

Works like a dream now, so thanks for all your help!!
 
This is a simpler way avoiding the use of VB...

this I can confirm works in Access 97/03/07 the versions I use.

In 2007 go to Access options then Advanced then untick the tick boxes next to "Record Changes", "Document Deletions" and "Action Queries"

In office 2003 and 97 the same thing was under tools I believe.
 
You're right, but the code was very simple for these anyway, so not a big issue.

Your way is easier as you only have to check the boxes once, where I had to add the code to all of my command buttons.
 
Spent a long time playing around and finally have some working code -

Code:
Private Sub Command13_Click()
On Error GoTo ErrorHandler
Dim mydb As DAO.Database
Dim rs As DAO.Recordset
Set mydb = CurrentDb()
Set rs = mydb.OpenRecordset("6g daily email query", dbOpenSnapshot)
With rs
.MoveFirst
Do Until rs.EOF
If IsNull(rs.Fields(0)) = False Then
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Todays Testing for " & rs.Fields(1)
objMessage.Sender = "[EMAIL="bwbsl.testing@bwbsl.co.uk"]bwbsl.testing@bwbsl.co.uk[/EMAIL]"
objMessage.To = rs.Fields(0)
objMessage.TextBody = "Below is a listing of testing work for you Today. If you need a detailed listing of tests, please contact the Testing Team who will provide this.  " & vbCrLf & _
                    "Number of Tests Due to Complete Today: " & rs.Fields(2) & vbCrLf & _
                    "Number of Tests Due to Start Today: " & rs.Fields(3) & vbCrLf & _
                    "Number of Tests Past Planned Completion Date: " & rs.Fields(4) & vbCrLf & _
                    "Number of Tests Past Planned Start Date: " & rs.Fields(5) & vbCrLf & _
                    "Number of Tests Due to Start Tomorrow Prep Not Complete: " & rs.Fields(6)
 
 
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/sendusing[/URL]") = 2
 
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserver[/URL]") = "smtp.server.com"
 
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserverport[/URL]") = 25
objMessage.Configuration.Fields.Update
 
objMessage.Send
End If
.MoveNext
Loop
rs.Close
Set rs = Nothing
ErrorHandlerExit:
    Exit Sub
ErrorHandler:
    If Err = 3021 Then
        MsgBox "There are no emails to send"
End If
End With
End Sub
So a couple of things I had missed included referencing the current Database for the recordset and when referencing fields from a query I had to use "." and not "!"

Works like a dream now, so thanks for all your help!!

I tried using your example and removed all the recordset references since I won't be using them. I'm drawing email strings directly from the Forms.

However, i'm getting a run time error "The "SendingUsing" configuration value is invalid"

I have referenced Microsoft CDO 1.21 Library in the Tools menu.

Code:
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Todays Testing for "
objMessage.From = "Project Testing <bwbsl.testing@bwbsl.co.uk>"
objMessage.Sender = "Project Testing <bwbsl.testing@bwbsl.co.uk>"
objMessage.To = TheAddress
objMessage.TextBody = "Below is a listing of testing work for you Today. If you need a detailed listing of tests, please contact the Testing Team who will provide this.  " & vbCrLf & _
                    "Number of Tests Due to Complete Today: " & vbCrLf & _
                    "Number of Tests Due to Start Today: " & vbCrLf & _
                    "Number of Tests Past Planned Completion Date: " & vbCrLf & _
                    "Number of Tests Past Planned Start Date: " & vbCrLf & _
                    "Number of Tests Due to Start Tomorrow Prep Not Complete: "

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/con...tion/sendusing") = 2

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/con...ion/smtpserver") = "smtp.server.com"

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/con...smtpserverport") = 25
objMessage.Configuration.Fields.Update

objMessage.Send
 
Code:
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Todays Testing for "
objMessage.From = "Project Testing <bwbsl.testing@bwbsl.co.uk>"
objMessage.Sender = "Project Testing <bwbsl.testing@bwbsl.co.uk>"
objMessage.To = TheAddress
objMessage.TextBody = "Below is a listing of testing work for you Today. If you need a detailed listing of tests, please contact the Testing Team who will provide this.  " & vbCrLf & _
                    "Number of Tests Due to Complete Today: " & vbCrLf & _
                    "Number of Tests Due to Start Today: " & vbCrLf & _
                    "Number of Tests Past Planned Completion Date: " & vbCrLf & _
                    "Number of Tests Past Planned Start Date: " & vbCrLf & _
                    "Number of Tests Due to Start Tomorrow Prep Not Complete: "

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/con[COLOR=red]figurat[/COLOR]ion/sendusing") = 2

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/con[COLOR=red]figurat[/COLOR]ion/smtpserver") = "smtp.server.com"

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/con[COLOR=red]figuration/[/COLOR]smtpserverport") = 25
objMessage.Configuration.Fields.Update

objMessage.Send

JR
 
Found my smtp server address to avoid the "The transport failed to connect to the server" error.

The database successfully works on my computer, however, many other computers on the network can't open it as it pops up with a Missing CDO 1.21 Library reference error.

How is this possible when the CDO 1.21 is just references inside the MS Access Visual Basic editor and not show up for other computers that are running Office 2003 and 2007. (I'm using Office 03)
 

Users who are viewing this thread

Back
Top Bottom