Multiple attachments stored in DB attached to Email (1 Viewer)

Larkin

New member
Local time
Today, 00:55
Joined
May 29, 2022
Messages
19
Hey all,

I am attempting to have an On_Click event call a public sub to attach all the .pdfs stored in a query directly to an email. I keep getting a Too few parameters and I am unsure as to why, I have tried multiple ways to fix this, including different ways of pulling the records needed. In the end I found a block of code on the forums that was reported to work, that I understand well, and was exactly what I needed. For some reason that is also giving me too few parameters. Please find a redacted version of the code below. The error appears to occur on the Set pBioAttachments line.
Code:
Option Compare Database
Option Explicit

Public Sub SendBio(MessageBody As String, RecipientEmail As String, Subject As String, AttachmentFile As String)

Dim O As Outlook.Application
Dim M As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment

Set O = New Outlook.Application
Set M = O.CreateItem(olMailItem)

With M
        .BodyFormat = olFormatHTML
        .HTMLBody = MessageBody
        .To = RecipientEmail
        .CC = "email3@email.com"
        .BCC = "email@email.com; email2@email.com"
        .Subject = Subject
        .Attachments.Add AttachmentFile
        .SentOnBehalfOfName = "email3@email.com"

    Dim db As DAO.Database
    Dim pBioAttachments As DAO.Recordset
   
    Set db = CurrentDb()
    Set pBioAttachments = db.OpenRecordset("Select [FIELD NAME] from QUERYNAME")
   
    If pBioAttachments.RecordCount > 0 Then
        With pBioAttachments
            Do Until .EOF
                O.Attachments.Add (pBioAttachments![FIELD NAME])
                .MoveNext
            Loop
        End With
    End If

    .Save
    .Display
End With

Set M = Nothing
Set objOutlookAttach = Nothing
Set O = Nothing
Set pBioAttachments = Nothing
Set db = Nothing

End Sub
 
Last edited:

Larkin

New member
Local time
Today, 00:55
Joined
May 29, 2022
Messages
19
This is the code that calls the above one:
Code:
Private Sub Command25_Click()
    
    Dim MessageBody As String
    Dim RecipientEmail As String
    Dim Subject As String
    Dim AttachmentFile As String
    
    TempVars!DataPass = Me.Assignment_ID.Value
        
    Subject = "SUBJECT"
    RecipientEmail = Email
    MessageBody = "MESSAGE"
    AttachmentFile = CurrentProject.Path & "\FILENAME.PDF"
    DoCmd.OutputTo acOutputReport, "Order Form", acFormatPDF, CurrentProject.Path & "\FILENAME.PDF"
  
    SendBio MessageBody, RecipientEmail, Subject, AttachmentFile

End Sub
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 15:55
Joined
May 7, 2009
Messages
19,169
does the QUERYNAME query has some Parameters on it?
it is has, what are their name?
 

Larkin

New member
Local time
Today, 00:55
Joined
May 29, 2022
Messages
19
So it does have parameters on the query, which is a criteria in the [Assignment Details].[Assignment ID] field it only pulls the records where that field = the DataPass TempVar.

Originally I tried the querydef way of creating the recordset and the arguments for all that, I don't remember the error I was getting with that method. I tried defining the parameter and I also tried using the For EVal method.
does the QUERYNAME query has some Parameters on it?
it is has, what are their name?
 

Larkin

New member
Local time
Today, 00:55
Joined
May 29, 2022
Messages
19
Oh wait, I see what you are getting at now, because the query is parametered I need to input a parameter for that. Wow. I don't know why that didn't hit me. Would that be done by adding a where statement to the select line, or do I need to call the parameter? If I need to call the parameter how would I get the name of it, as I honestly just wrote the query in SQL in the query designer.
 

Larkin

New member
Local time
Today, 00:55
Joined
May 29, 2022
Messages
19
So I attempted these changes, and I am getting a data type conversion error. Which is strange as the TempVar is the same, and is a int just as the field it matches against. I am not sure what is causing this.
Code:
Option Compare Database
Option Explicit

Public Sub SendBio(MessageBody As String, RecipientEmail As String, Subject As String, AttachmentFile As String)

Dim O As Outlook.Application
Dim M As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment

Set O = New Outlook.Application
Set M = O.CreateItem(olMailItem)

With M
        .BodyFormat = olFormatHTML
        .HTMLBody = MessageBody
        .To = RecipientEmail
        .CC = "email3@email.com"
        .BCC = "email@email.com; email2@email.com"
        .Subject = Subject
        .Attachments.Add AttachmentFile
        .SentOnBehalfOfName = "email3@email.com"

    Dim db As DAO.Database
    Dim pBioAttachments As DAO.Recordset
    Dim qdf As DAO.QueryDef

    Set db = CurrentDb()
    Set qdf = db.QueryDefs("QUERYNAME")
  
    'Debug.Print (TempVars!DataPass) this was used to ensure that DataPass was pulling correct value
  
    qdf("TempVars!DataPass") = TempVars!DataPass
    Set pBioAttachments = qdf.OpenRecordset("Select [FIELD NAME] from QUERYNAME")

    If pBioAttachments.RecordCount > 0 Then
        With pBioAttachments
            Do Until .EOF
                O.Attachments.Add (pBioAttachments![FIELD NAME])
                .MoveNext
            Loop
        End With
    End If

    .Save
    .Display
End With

Set M = Nothing
Set objOutlookAttach = Nothing
Set O = Nothing
Set pBioAttachments = Nothing
Set db = Nothing

End Sub
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 15:55
Joined
May 7, 2009
Messages
19,169
i made changes but cannot run since i don't have the query in my db.
test it and check if it will work:
Code:
Public Sub SendBio(MessageBody As String, RecipientEmail As String, Subject As String, AttachmentFile As String)

Dim O As Outlook.Application
Dim M As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment

Set O = New Outlook.Application
Set M = O.CreateItem(olMailItem)

With M
        .BodyFormat = olFormatHTML
        .HTMLBody = MessageBody
        .To = RecipientEmail
        .CC = "email3@email.com"
        .BCC = "email@email.com; email2@email.com"
        .Subject = Subject
        .Attachments.Add AttachmentFile
        .SentOnBehalfOfName = "email3@email.com"

    Dim db As DAO.Database
    Dim pBioAttachments As DAO.Recordset
    Dim qdf As DAO.QueryDef
 
    Set db = CurrentDb()
    Set qdf = db.QueryDefs("QUERYNAME")
  
    'Debug.Print (TempVars!DataPass) this was used to ensure that DataPass was pulling correct value
  
   'arnelgp
    With qdf
        .Parameters(0) = TempVars!DataPass
        Set pBioAttachments = db.OpenRecordset()
    End With
 
    If pBioAttachments.RecordCount > 0 Then
        With pBioAttachments
            Do Until .EOF
                O.Attachments.Add (pBioAttachments![FIELD NAME])
                .MoveNext
            Loop
            'arnelgp
            .Close
        End With
        
    End If

    .Save
    .Display
End With

Set M = Nothing
Set objOutlookAttach = Nothing
Set O = Nothing
Set pBioAttachments = Nothing
Set db = Nothing

End Sub
 

Larkin

New member
Local time
Today, 00:55
Joined
May 29, 2022
Messages
19
So that helped make some progress. Now I am getting an item not in collection on the O.Attachments.Add line, however using a For Each I had the code print the name of the fields, and the field I am trying to pull is definitely there, I also checked and ensured that there is a document in that field, and I have already created a test record so that I am only returning the one record with the attachment.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 15:55
Joined
May 7, 2009
Messages
19,169
does pBioAttachments![FIELD NAME] contains the "path+thefilename" to attach?
 

Larkin

New member
Local time
Today, 00:55
Joined
May 29, 2022
Messages
19
In addition, I ran a watch on qdf, and I can definitely see the field there, all the sudden it started giving me an object doesnt support this action error, so I assumed I needed to save the attachments first, but effectively in that sub I am back to it declaring that the object doesnt exist, but I can see the field in watch, and It will print the field in that same For loop.

Updated Code for the original Sub that should just make attachments out of the stored attachments:
Code:
Public Sub SendBio(MessageBody As String, RecipientEmail As String, Subject As String, AttachmentFile As String)

Dim O As Outlook.Application
Dim M As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment

Set O = New Outlook.Application
Set M = O.CreateItem(olMailItem)

With M
        .BodyFormat = olFormatHTML
        .HTMLBody = MessageBody
        .To = RecipientEmail
        .CC = "email3@email.com"
        .BCC = "email@email.com; email2@email.com"
        .Subject = Subject
        .Attachments.Add AttachmentFile
        .SentOnBehalfOfName = "email3@email.com"

    Dim db As DAO.Database
    Dim pBioAttachments As DAO.Recordset
    Dim qdf As DAO.QueryDef
    Dim fd As DAO.Field

    Set db = CurrentDb()
    Set qdf = db.QueryDefs("QUERYNAME")

    'Debug.Print (TempVars!DataPass) this was used to ensure that DataPass was pulling correct value

    With qdf
        .Parameters(0) = TempVars!DataPass
        Set pBioAttachments = qdf.OpenRecordset()
    End With
   
    'For Each fd In qdf.Fields
        'Debug.Print fd.Name
    'Next

    If pBioAttachments.RecordCount > 0 Then
        With pBioAttachments
            Do Until .EOF
                O.Attachments.Add ("[FIELD NAME]")
                .MoveNext
            Loop
        Close
        End With
       
    End If

    .Save
    .Display
End With

Set M = Nothing
Set objOutlookAttach = Nothing
Set O = Nothing
Set pBioAttachments = Nothing
Set db = Nothing

End Sub

Code for the function to save attachments which was this code is based off some I found while researching the first sub

Code:
Option Compare Database
Option Explicit

Public Function SaveAttachments(strPath As String, Optional strPattern As String = "*.*") As Long
    Dim db As DAO.Database
    Dim rsq As DAO.Recordset2
    Dim rsA As DAO.Recordset2
    Dim fd As DAO.Field
    Dim fld As DAO.Field2
    Dim strFullPath As String
    Dim qdf As DAO.QueryDef
   
   
    Set db = CurrentDb()
    Set qdf = db.QueryDefs("QUERYNAME")
   
    With qdf
        .Parameters(0) = TempVars!DataPass
        Set rsq = qdf.OpenRecordset()
    End With

    'For Each fd In qdf.Fields
        'Debug.Print fd.Name
    'Next

   
    Set fld = rsq("[FIELDNAME]")
   
     Do While Not rsq.EOF
   
        Set rsA = fld.Value

        Do While Not rsA.EOF
            If rsA("FileName") Like strPattern Then
                strFullPath = strPath & "\" & rsA("FileName")
               
                If Dir(strFullPath) = "" Then
                    rsA("FileData").SaveToFile strFullPath
                End If
               
                SaveAttachments = SaveAttachments + 1
            End If
           
            rsA.MoveNext
        Loop
        rsA.Close
       
        rsq.MoveNext
    Loop
   
    rsq.Close
    db.Close
   
    Set fld = Nothing
    Set rsA = Nothing
    Set rsq = Nothing
    Set db = Nothing
End Function

Code for the Click event
Code:
Private Sub Command25_Click()
    
    Dim MessageBody As String
    Dim RecipientEmail As String
    Dim Subject As String
    Dim AttachmentFile As String
    Dim strPath As String
    
    strPath = CurrentProject.Path
    
    SaveAttachments (strPath)
    
    TempVars!DataPass = Me.Assignment_ID.Value
        
    Subject = "SUBJECT"
    RecipientEmail = Email
    MessageBody = "MESSAGE"
    AttachmentFile = CurrentProject.Path & "\FILENAME.PDF"
    DoCmd.OutputTo acOutputReport, "Order Form", acFormatPDF, CurrentProject.Path & "\FILENAME.PDF"
 
    SendBio MessageBody, RecipientEmail, Subject, AttachmentFile

End Sub
 

Larkin

New member
Local time
Today, 00:55
Joined
May 29, 2022
Messages
19
does pBioAttachments![FIELD NAME] contains the "path+thefilename" to attach?
So It does, as the attachment is stored in the DB, and that field holds the like 5 or 6 fields an attachment field does including Name and path, but assuming maybe access doesnt parse that well, I started to attempt to export the files so that then I could in essence simplify the attach code to just be all the files in this folder attach them. However that is also giving the same error. I have replied with the code for those 3 items in question, the attach, the export, and the click. I will post a censored query SQL below for assistance. I am headed to bed, but I truly appreciate all your assistance.

SQL Query:
SQL:
SELECT [Table1].[Field1], [Table2].[Field1], [Table2].[Field2], [Table2].[ATTACHMENT]
FROM [Table1] INNER JOIN [Table2] ON [Table1].[Field2].Value = [Table2].[Field4]
WHERE ((([Table1].[Field1])=[TempVars]![DataPass]));
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 15:55
Joined
May 7, 2009
Messages
19,169
the way i see your code is that your Attachment is a report (.pdf).
using O.Attachments.Add will not work since, o is Outlook object and not MailItem.
you should use M.

do you need to add the Attachment fields to your email?
 

Larkin

New member
Local time
Today, 00:55
Joined
May 29, 2022
Messages
19
Interesting. I did not try m. Yeah effectively what I need to do is take the attachment(s) from that query and auto add them to the email. So there is also a report generated that needs to be attached as well, that part I have had working for awhile. Another option would be to add the attachments into the report so that they "print" normally. To my knowledge I can't combine them into the report, if I can, I am more than happy to save this code as a fun fix it project and deploy a working solution.

To give some background:
The DB consists of 4 tables, Table1 is basically all the details of an order, Table 2 is the details of the client, Table 3 is details of the subcontractor assigned, Table 4 is the details of the Firms that provide subcontractors. This has a standard split, with the BE containing the tables that are linked to the FE.

The PK of Table 1 is in Table 2 as a field, the PK of Tables 3 and 4 are also in Table 1 as fields, Table 1's PK is sort of the unique identifier no matter how the tables are combined for different queries. DataPass is basically used as a tempvar to hold the PK from Table 1 across various forms or reports.

Effectively what I have attempted to do is create a form that you basically assign the subcontractor(s) to the order and then you click a button and it prepares an email to go to all relevant parties with an order form and copies of the Bio(s) of the subcontractors. Those Bios are stored as attachments in Table 3 on the record of each subcontractor.

It was requested that instead of an employee having to manually save those attachments to basically make it auto attach to the email with the report.

For the record I work at a startup and as I used to work in IT many moons ago I was asked to develop this DB instead of the 5 Google sheets, and 2 forms and multiple folders we were using before. I am by no means an Access wizard, SQL, Java, C++ and various Lua spinoffs used in games I am much more familiar with. But my request to just build an SQL server was turned down. So I will probably do somethings that make you scratch your head as I am experienced in programming and databases just not access or vba.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 15:55
Joined
May 7, 2009
Messages
19,169
ok i re-created your table and query.
you copy all codes:
Code:
Private Sub Command25_Click()
   
    Dim MessageBody As String
    Dim RecipientEmail As String
    Dim Subject As String
    Dim AttachmentFile As String
    Dim strPath As String
    'arnelgp
    Dim ary() As Variant
    Dim n As Integer
    ReDim ary(1 To 500)
   
    strPath = CurrentProject.Path
   
    n = SaveAttachments(strPath, , ary)
    ReDim Preserve ary(1 To n)
   
    TempVars!DataPass = Me.Assignment_ID.Value
       
    Subject = "SUBJECT"
    RecipientEmail = Email
    MessageBody = "MESSAGE"
    AttachmentFile = CurrentProject.Path & "\FILENAME.PDF"
    DoCmd.OutputTo acOutputReport, "Order Form", acFormatPDF, CurrentProject.Path & "\FILENAME.PDF"

    SendBio MessageBody, RecipientEmail, Subject, AttachmentFile, ary

End Sub

Code:
Public Sub SendBio(MessageBody As String, RecipientEmail As String, Subject As String, AttachmentFile As String, Optional ary As Variant)

Dim O As Outlook.Application
Dim M As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment

Set O = New Outlook.Application
Set M = O.CreateItem(olMailItem)

Dim var As Variant

With M
        .BodyFormat = olFormatHTML
        .HTMLBody = MessageBody
        .To = RecipientEmail
        .CC = "email3@email.com"
        .BCC = "email@email.com; email2@email.com"
        .Subject = Subject
        .attachments.Add AttachmentFile
        .SentOnBehalfOfName = "email3@email.com"


        'arnelgp
        'add more attachments from array
        If IsArray(ary) Then
            For Each var In ary
                .attachments.Add var
            Next
        End If

    .Save
    .Display
End With

Set M = Nothing
Set objOutlookAttach = Nothing
Set O = Nothing


End Sub


Code:
Public Function SaveAttachments(strPath As String, Optional strPattern As String = "*.*", Optional ary As Variant = Null) As Long
    Dim db As DAO.Database
    Dim rsq As DAO.Recordset2
    Dim rsA As DAO.Recordset2
    Dim fd As DAO.Field
    Dim fld As DAO.Field2
    Dim strFullPath As String
    Dim qdf As DAO.QueryDef
 
 
    Set db = CurrentDb()
    Set qdf = db.QueryDefs("QUERYNAME")
 
    With qdf
        .Parameters(0) = TempVars!DataPass
        Set rsq = qdf.OpenRecordset()
    End With

    'For Each fd In qdf.Fields
        'Debug.Print fd.Name
    'Next

 
    Set fld = rsq("[FIELDNAME]")
 
     Do While Not rsq.EOF
 
        Set rsA = fld.Value

        Do While Not rsA.EOF
            If rsA("FileName") Like strPattern Then
                strFullPath = strPath & "\" & rsA("FileName")
             
                If Dir(strFullPath) = "" Then
                    rsA("FileData").SaveToFile strFullPath
                End If
             
                SaveAttachments = SaveAttachments + 1
               
                'arnelgp
                If IsArray(ary) Then
                    ary(SaveAttachments) = strFullPath
                End If
            End If
         
            rsA.MoveNext
        Loop
        rsA.Close
     
        rsq.MoveNext
    Loop
 
    rsq.Close
    'db.Close
 
    Set fld = Nothing
    Set rsA = Nothing
    Set rsq = Nothing
    Set db = Nothing
End Function
 

Users who are viewing this thread

Top Bottom