Attaching files to email Access 2016 (1 Viewer)

jmsjazz

Registered User.
Local time
Today, 07:03
Joined
Mar 19, 2013
Messages
43
The attached code was written to enable a database form with multiple attached pdfs to be emailed from the command-click button on the form.
Since some machines have been upgraded to the latest versions of Windows 10 and Office 16, I get different errors, such as "User-defined Type not defined" (mostly to do with recordset and savetofile commands). It still works on machines that were not upgraded. I read it may be due to the DAO 3.6 reference library, but I have installed that.
Can anyone please help? I have been going round in circles for hours!
I changed a couple of references to file directories in the below code.
Many thanks in advance..

Code:
Private Sub cmdMAILTEAM_Click()
Dim oAPP As Object
Dim oEMail As Object
' Reference library set to DAO 3.6
Dim rstAttachments As DAO.Recordset
Dim db As DAO.Database
Dim rsParent As DAO.Recordset
Dim rsChild As DAO.Recordset

Set oAPP = CreateObject("Outlook.application")
Set oEMail = oAPP.CreateItem(0)

' Get atttachments ************************************
Set db = CurrentDb
Set rsParent = Me.Recordset
On Error Resume Next
Set rsChild = rsParent.Fields("Attachment").Value

folderspec = "C:\dbtemp"

    With rsChild
    .MoveFirst
    Do While Not .EOF

    rsChild.OpenRecordset
    rsChild.Fields("FileData").SaveToFile (folderspec) ' this line fails in Win10/Office 19
    
    .MoveNext
    Loop
    .Close
End With
*********************************************************
Set rsChild = Nothing
Set rsParent = Nothing

Dim OlApp As Object
Dim objMail As Object
Dim stWhere As String   '-- Criteria for DLookup
Dim varTo As Variant    '-- Address for SendObject
Dim stText As String    '-- E-mail text
Dim stWho As String     '-- email to this person
Dim stSubject As String '-- Subject line of e-mail
Dim stDESC As String
Dim stNoreply As String
Dim recid As String
Dim stdatum As Date
Dim stidate As String
Dim yrrecs As Integer
Dim eTotal As Long
Dim i As Long
Dim distro As String    '-- distribution group selected in FORM 

On Error Resume Next 'Keep going if there is an error

'*********************************************************
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim sSQL1 As String
Dim sSQL2 As String
Dim sSQL3 As String
'*************************************************************
'*************************************************************
'Send email **************************************************
    Set db = CurrentDb
    sSQL1 = "SELECT tblPOI.email, tblPOI.chosen FROM tblPOI WHERE tblPOI.chosen = TRUE"

    Set rs = db.OpenRecordset(sSQL1, dbOpenDynaset)

    Do While Not rs.EOF
        sSQL3 = rs.Fields("EMAIL")
        distro = distro & sSQL3 & "; "
        rs.MoveNext
    Loop
    varTo = Left(distro, Len(distro) - 2)
    If Len(varTo) > 0 Then
        MsgBox "sending to " & varTo
    Set rs = Nothing

    '*********************************************************

    Set OlApp = GetObject(, "Outlook.Application") 'See if Outlook is open *************************

    If Err Then 'Outlook is not open
        Set OlApp = CreateObject("Outlook.Application") 'Create a new instance of Outlook **********
    End If

    'Create e-mail item for distro group ***********************
    Set objMail = OlApp.CreateItem(olMailItem)
    stSubject = ""
    stDESC = Me.DESCRIPTION
    recid = Me.ID
    irec = Form.CurrentRecord
    strecyear = Me.txtrecordno & " of " & Me.txtYear & " (" & "ID " & recid & ")"
    stSubject = InputBox("Type Message Subject or use default: ")
    If Len(stSubject) = 0 Then
        stSubject = ":: New Incident ::"
    End If
    stNoreply = "This is an automated message.  Please do not reply."
    With objMail

    'For each file in "C:\dbtemp" **********************************
        strPath = "C:\dbtemp\"
        strFile = Dir(strPath & "*.*")

        Do While Len(strFile) > 0
            .Attachments.Add strPath & strFile
            strFile = Dir
        Loop
    '******************************************************
 

isladogs

MVP / VIP
Local time
Today, 11:03
Joined
Jan 14, 2017
Messages
18,186
In A2016 you should be using the newer reference Microsoft Office 16.0 Access database engine library instead of the DAO 3.6 library
 

jmsjazz

Registered User.
Local time
Today, 07:03
Joined
Mar 19, 2013
Messages
43
Thanks for this - but it won't let me remove or switch the Access 15 engine as it is in use - how can I do this?
 
Last edited:

jmsjazz

Registered User.
Local time
Today, 07:03
Joined
Mar 19, 2013
Messages
43
Thanks again for your advice - just found the solution by searching for the 16.olb file in the forum - this was posted here by Ganymede:

Thank you all for the help. I believe I have figured it out. The problem was that I had "Microsoft DAO 3.6 Object Library" enabled when I needed "Microsoft Office 12.0 Access database engine Object library" enabled in order to use Recordset2, field2 and Savetofile. Essentially, I had to disable DA0 3.6 and browse for ACEDAO.DLL in C:\Program Files\Common Files\microsoft shared\Office12\. Everything worked after I did that.

I removed DAO3.6 and added the file from the shared\Office16 folder and it worked.

Many thanks -
 

isladogs

MVP / VIP
Local time
Today, 11:03
Joined
Jan 14, 2017
Messages
18,186
Hi
Yes - that's exactly what I meant you to do. Sorry if I wasn't clear earlier
 
Last edited:

Users who are viewing this thread

Top Bottom