Consulting

Results 1 to 7 of 7

Thread: Access 2016 Send email with multiple attachements and auto subject!

  1. #1

    Exclamation 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":
     Public strRptFilter As String

    2. On invoice report event on open:
     If Len(strRptFilter) > 0 Then 
    Me.Filter = strRptFilter 
    Me.FilterOn = True
    End If

    3. On invoice report event on close:
     strRptFilter = vbNullString

    4. Made a button:
    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:
    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

  2. #2
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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.

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

  4. #4
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Do you want to send 1 email with 3 invoices or 3 emails with 1 invoice each?

  5. #5
    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...

  6. #6
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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 = ""

  7. #7
    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 .

    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •