Email merge error - 3048

[SoftwareTrainer]

Hi,

Some code was written in the past that worked fine until this last week or so then we get error 3048.  As per a lot of suggestions on this forum we have made the location of both the client end database and the root database on the network trusted, but still get this error.

As the code is a few years old I thought I would post to see if anyone knows of improvements we could make to it.

It is to send statements to different contacts, here is the code:

Private Sub Command62_Click()

Dim rst As DAO.Recordset

Set rst = CurrentDb.OpenRecordset("qry_mass_emails")

Do Until rst.EOF

    Me.unit_sales_unit_no_sel.value = rst("unit_no")

    If DCount("id", "tbl_trans", "unit_no=" & Me.unit_sales_unit_no_sel.value & " AND flag=False AND contra=False") > 0 Then

        Call sndrpt_unit_sales2

    Else

        Call sndrpt_unit_sales3

        'DoCmd.SendObject , , , DLookup("email", "tbl_tenants", "id=" & DLookup("tenant", "tbl_units", "unit_no=" & Me.unit_sales_unit_no_sel)), , , "Sales Report", "Sorry, you have no sales transactions to report on." & Chr(10) & Chr(10) & "Regards" & Chr(10) & "Astra Antiques", False

    End If

  rst.MoveNext

Loop

rst.Close

DoCmd.Close

DoCmd.OpenForm "frm_menu_reports", , , stLinkCriteria

MsgBox "Mass E-Mails Sent"

End Sub

Thanks for your suggestions.

Katherine

[#2]

Some of my clients got the error and adding Trusted Locations for their FE & BE solved the problem of both the 3048 error and the .laccdb lock file not getting deleted. I didn't get the 3048 error until last night.
My installed version is:
Version 2201 (Build 14827.20198 Click-to-Run); 32-bit version of MS Office Professional Plus 2016

So looks like they fixed some and broke others.

For anyone interested, here's a quick way to see if you have the bug:

1. Create a new accdb
2. Create a table (Dual for me) with 1 Autonumber field.
3. Add one record
4. Insert a new module
5. Copy and paste the following code that creates a short recursive routine:


Option Compare Database
Option Explicit

Public Sub BugTest(Optional DbCount As Long = 1)
On Error GoTo errHandler
Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("Select * from Dual", dbOpenDynaset)
Debug.Print "Open Db count: " & DbCount
If DbCount < 1000 Then BugTest DbCount + 1

ExitSub:
If Not rs Is Nothing Then rs.Close
Set rs = Nothing
Exit Sub
errHandler:
Debug.Print Err.Number, Err.Description
Stop
Resume
GoTo ExitSub
End Sub

6. run BugTest procedure.

For me, the routine stops with the 3048 -Cannot open any more databases. after opening 252 (errors opening the 253rd recordset)