Attaching files to email Access 2016

jmsjazz

Registered User.
Local time
Today, 01:50
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
    '******************************************************
 
In A2016 you should be using the newer reference Microsoft Office 16.0 Access database engine library instead of the DAO 3.6 library
 
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:
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 -
 
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

Back
Top Bottom