Forum Discussion

SoftwareTrainer's avatar
SoftwareTrainer
Copper Contributor
Feb 04, 2022

Email merge error - 3048

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

Access 2016
Access vba
  • mPasGamer's avatar
    mPasGamer
    Copper Contributor
    Feb 21, 2022
    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)

Resources