Sending email through Microsoft Access Looping Through Query

I have approx half dozen reports that need to go out to a dozen or so people, some daily, some weekly, others monthly.   The list is fairly dynamic and could change every few weeks.
So I built a table that keeps track of; Who gets it, How Often, Which Report, and What Criteria.
I have queries that run through that list based on FREQUENCY, and I've tried to build some code that loops through the records in the query and sends an email out to everyone on the list.

I'm keeping the Criteria on a FORM that I run the code from with a button....  I'm sure that's not the way it should be done, but my skillset is lacking a bit.
The total record count is usually less than 25.

It kind of works... I've screwed up the NEXT thing, but I can do more searching and figure out that issue I think...

My main problem...  when I turn off the warnings in OUTLOOK (Options/Trust Center Settings/Programatic Access) to never warn me, then I get an error that pops up and says "Microsoft Access Can't Send This Email".

It was working before I did that.   If I set that back to Warn me if Virus Protection..., then it starts sending emails again.
Thanks in advance.

Private Sub cmd3_DblClick(Cancel As Integer)
'On Error GoTo SumTingWong

        Dim i As Integer
        Dim db As Database
        Dim rs As Recordset

        Set db = CurrentDb
        Set rs = db.OpenRecordset("qrySendReportsList_Daily")
        Dim stRecCount As Integer
        stRecCount = rs.RecordCount
        For i = 0 To stRecCount

Debug.Print stRecCount

'Get the report number
Dim stRptSendID As Long
stRptSendID = Nz(rs.Fields("RptSendID"), "Problem")
Dim stSendQuery As String
stSendQuery = "qrySendReportsList_Daily"

Dim stStart As Date
Dim stEnd As Date
Dim stCompany As String
Dim stFacility As String
Dim stArea As String
Dim stShift As String
Dim stDimension As String
Dim stReportName As String
Dim stTo As String
Dim stFrom As String
Dim stSubject As String
Dim stBody1 As String
Dim stBody2 As String
Dim stBody3 As String

stReportName = Nz(DLookup("[ReportTitle]", stSendQuery, "[RptSendID] = " & stRptSendID), "No Report Found Joe")
stCompany = Nz(DLookup("[CritCompany]", stSendQuery, "[RptSendID] = " & stRptSendID), 999)
stFacility = Nz(DLookup("[CritFacility]", stSendQuery, "[RptSendID] = " & stRptSendID), 999)
stStart = Date + Nz(DLookup("[CritStart_Offset]", stSendQuery, "[RptSendID] = " & stRptSendID), 0)
stEnd = Date + Nz(DLookup("[CritEnd_Offset]", stSendQuery, "[RptSendID] = " & stRptSendID), 0)
stTo = Nz(DLookup("[SendTo]", stSendQuery, "[RptSendID] = " & stRptSendID), "error")
stFrom = Nz(DLookup("[SendFrom]", stSendQuery, "[RptSendID] = " & stRptSendID), "error")
stSubject = Nz(DLookup("[Subject]", stSendQuery, "[RptSendID] = " & stRptSendID), "error")
stBody1 = Nz(DLookup("[Body1]", stSendQuery, "[RptSendID] = " & stRptSendID), "error")
stBody2 = Nz(DLookup("[Body2]", stSendQuery, "[RptSendID] = " & stRptSendID), "error")
stBody3 = Nz(DLookup("[Body3]", stSendQuery, "[RptSendID] = " & stRptSendID), "error")

Me.CompanyCombo.Value = stCompany
Me.FacilityCombo.Value = stFacility
Me.StartDate.Value = stStart
Me.EndDate.Value = stEnd

Debug.Print stStart
Debug.Print stEnd

Call TempTableRefresh

DoCmd.SendObject acSendReport, stReportName, "PDF", stTo, , , stSubject, "Hello," & vbCrLf & stBody1 & vbCrLf & vbCrLf _
& stBody2 & vbCrLf & stBody3, False

Next i

Set rs = Nothing

Exit Sub
DoCmd.SetWarnings True
DoCmd.Hourglass False

Dim stErrMsg As String
Dim stErrCode As String
stErrCode = "Hey .." & Err.Description & "Number-" & Err.Number
stErrMsg = MsgBox("There was a problem", vbOKOnly, "Looks like something didn't go as expected")
Set rs = Nothing

End Sub

Open in new window

Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

You can purchase the Redemption library which will get around this security issue. also has a tool that might work.  If you are working in a company with IT support, the support staff might be able to modify the security settings to get past this.  I con't believe you can fix it yourself.
TechGuiseAuthor Commented:
Not sure I’m following you. If an IT staff can modify security settings, then I should be able to. (Especially on a stand alone box that isn’t on a domain).
Perhaps an Outlook expert will know the answer.  You might want to post your Outlook version and whether it is O365 or a perpetual license.
The Five Tenets of the Most Secure Backup

Data loss can hit a business in any number of ways. In reality, companies should expect to lose data at some point. The challenge is having a plan to recover from such an event.

Jim Dettman (Microsoft MVP/ EE MVE)President / OwnerCommented:
You cannot get around the Outlook security model without a 3rd party add-in.  That is by design and a security feature.   There is no way to turn it off.

 Pat mentioned one 3rd party lib, which is Redemption.   There is also vbMAPI:

  But if all your doing is sending e-mail, then there is no need to use Outlook.   Instead, you can talk directly to a SMTP server to send the mail.   FMS, Inc's Total Access e-mailer will do that, or there are free alternatives such as BLAT, vbSendMail, or using the CDO libraries.

TechGuiseAuthor Commented:
Thanks Jim, You had me at "Free Alternatives"
Jim Dettman (Microsoft MVP/ EE MVE)President / OwnerCommented:
Well vbSendMail is one:

 Although it's says VB6, it's a drop in to VBA.   You just need to register the DLL for the "install" and drop the code into your app.  The documentation gives examples how to use it.

There's also BLAT:

 There's either a command line utility you can call with Shell(), or a DLL that you can call directly.   The command line utility is nice in that you can work outside of your code to test things.  

 I've used both, first BLAT and then vbSendMail.   Both work well, but I would suggest sticking with vbSendMail.  The only hassle with it is registering the DLL.    If your not widely distributing the app, then it's not really an issue.   I do have code somewhere to register the DLL as part of your app, but I've never used it myself.

 I've moved onto vbMapi and Outlook for sending e-mail in most cases.   I still have apps using vbSendmail out there though.


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
BE wary of tools that require the distribution of a .dll for every user.  This can become a big problem.
TechGuiseAuthor Commented:
Very helpful, thank you!  
This will just be running on a bench PC for me.  Not distributing.  

I have a hosted SQL server that is doing a daily data dump, and I wanted Access to wake up once a day, import and cleanup the data, then send out some reports (which are mostly charts).
The eventual goal is to move 100% of this to the online SQL server, but this will get me by until I find an SQL "reporting solution" that I can either figure out how to build myself, or can afford to pay someone to build.  I know just enough about SQL to be dangerous.

Thanks again!
Jim Dettman (Microsoft MVP/ EE MVE)President / OwnerCommented:
Holler if you get stuck on anything.

sandra louisCommented:
Well I also needs to know that how can I send an email through an account using MS Access VBA? I know this question is vague but it's so hard to find the relevant information online that isn't outdated in some way. So if anyone having answer to this query then do share it with me.
TechGuiseAuthor Commented:
Hi Sandra,
The vbSendMail that Jim referenced is a good solution.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.