Access 2016 Send email with multiple attachements and auto subject!

Hi,
i have an access invoice database. We have an online accounting software, which reads sended pdf invoice by mail automatically.
We want select a range invoice numbers ie: 20100058 - 20100060(access report) convert to PDF, attach these 3 invoices in pdf to mail and send to specific mail address.


Till here everything works fine.
here's my code:


1. i made a module "SepPDF":

Code:

---

Public strRptFilter As String

---

2. On invoice report event on open:

Code:

---

If Len(strRptFilter) > 0 Then
Me.Filter = strRptFilter
Me.FilterOn = True
End If

---

3. On invoice report event on close:

Code:

---

strRptFilter = vbNullString

---

4. Made a button:

Code:

---

Private Sub Command24_Click()


Dim rst As DAO.Recordset
Dim strInputStart As String, strInputEind As String, strInputLng As String, booNotWholeNumber As Boolean




booNotWholeNumber = False


strInputStart = InputBox("Start Factuur Nummer")
strInputEind = InputBox("Eind Factuur Nummer")




Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [factuurid] FROM [tbl_vh_factuur] WHERE (tbl_vh_factuur.factuurid Between " & strInputStart & " And " & strInputEind & " ) ORDER BY [factuurid];", dbOpenSnapshot)


Do While Not rst.EOF
    strRptFilter = "[factuurid] = " & rst![factuurid]


    DoCmd.OutputTo acOutputReport, "rpt_vh_factuur_reeks_CL_PDFYUKI", acFormatPDF, "K:\01-Administratie\Database\Yuki_Upload\VH" & "\VH-" & rst![factuurid] & ".pdf"
    DoEvents
    rst.MoveNext
Loop


rst.Close
Set rst = Nothing


strInputStart = vbNullString
strInputEind = vbNullString


'----------Mail declaraties----------------
    Dim mess_body As String, StrFile As String, StrPath As String
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem


    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)


    ' path here
    StrPath = "K:\01-Administratie\Database\Yuki_Upload\VH\"
'----------Mail declaraties----------------


With MailOutLook
        .BodyFormat = olFormatRichText
        .To = "email address"
               
        StrFile = Dir(StrPath & "*.*")


        Do While Len(StrFile) > 0
            .Attachments.Add StrPath & StrFile
            .Subject = StrFile
            StrFile = Dir
        Loop


        .Send
    End With


MsgBox "Reports have been sent", vbOKOnly


End Sub

---

Problem is:

Code:

---

Do While Len(StrFile) > 0
            .Attachments.Add StrPath & StrFile
            .Subject = StrFile

---

line:.Subject = StrFile takes only the last invoice name, so in my sended mail i see subject 20100060.pdf.
I want see 3 names of attached files as subject. ie subject: 20100058, 20100059, 20100060.
How can i arange that? Tried allready so many things...


Thnx in advance

The main issue is that th email section of your code is outside the loop that creates the File and file name that you wish to use in the email attachment.

Yes i thought the same but i wasnt able to let it work in the loop...So if you have an idea how to...

Do you want to send 1 email with 3 invoices or 3 emails with 1 invoice each?

send 1 email, within attached 3 files(ie 20100058.pdf, 20100059.pdf, 20100060.pdf) and as subject: 20100058, 20100059, 20100060.

So far the code works. it creates 1 mail with attached 3 pdf's. But collecting and adding 3 subjectnames i have problems...

OK, in the Dim statement add
Subject as string
Then in the Do while Not rst.EOF loop after the line
strRptFilter = "[factuurid] = " & rst![factuurid]
add the following line of code
Subject = Subject & rst![factuurid] & ", "

The add another line after line Loop add
Subject = left(Subject, len(Subject) -2)


Then change this line
.subject = StrFile
to
.subject = Subject

You could add a line after the Dim statement to set the Subject string to "" if you run the code more than once
ie
Subject = ""

Thanks you very much! Worked like a charm! here is my total code for those who have nearly the same situation or for those who want some inspiration :).

Code:

---

Dim rst As DAO.Recordset
Dim strInputStart As String, strInputEind As String, strInputLng As String, booNotWholeNumber As Boolean, strInputmail As String
Dim Subject As String


booNotWholeNumber = False


strInputStart = InputBox("Start Factuur Nummer")
strInputEind = InputBox("Eind Factuur Nummer")




Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [factuurid] FROM [tbl_vh_factuur] WHERE (tbl_vh_factuur.factuurid Between " & strInputStart & " And " & strInputEind & " ) ORDER BY [factuurid];", dbOpenSnapshot)


Do While Not rst.EOF
    strRptFilter = "[factuurid] = " & rst![factuurid]
    Subject = Subject & rst![factuurid] & ", "


    DoCmd.OutputTo acOutputReport, "rpt_vh_factuur_reeks_CL_PDFYUKI", acFormatPDF, "K:\01-Administratie\Database\Yuki_Upload\VH" & "\VH-" & rst![factuurid] & ".pdf"
    DoEvents
    rst.MoveNext
Loop


Subject = Left(Subject, Len(Subject) - 2)


rst.Close
Set rst = Nothing


strInputStart = vbNullString
strInputEind = vbNullString


'----------Mail declaraties----------------
    Dim mess_body As String, StrFile As String, StrPath As String
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
 


    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)


    '--> path here
    StrPath = "K:\01-Administratie\Database\Yuki_Upload\VH\"
    strInputmail = InputBox("Voer Bestemmings Mail adres")


With MailOutLook
        .BodyFormat = olFormatRichText
        .To = strInputmail
               
        '--> *.* for all files
        StrFile = Dir(StrPath & "*.*")


        Do While Len(StrFile) > 0
            .Attachments.Add StrPath & StrFile
            .Subject = Subject
            StrFile = Dir
           
        Loop




        '.DeleteAfterSubmit = True
        .Send
    End With
 
'----------Mail declaraties----------------


MsgBox "Reports have been sent", vbOKOnly

---