Multiple attachments and a report in the same email (1 Viewer)

[mounty76]

Hi All,

I have a field in a table that holds file paths to PDFs of invoices, I am trying to put some code behind a button that attaches the invoices that have not yet been sent to the office, also there is a report that I would like attached to the same email. I have the code below but it is only attaching the first invoice (from the QueryFiles query)....I'm losing the will to live so any help would be greatly appreciated! It saves the report and loops through the records but just not sure how to put all the paths together into the email..?

Private Sub Officebtn_Click()

On Error GoTo ErrorHandler

Dim nrecords As String
Dim recip As String
Dim msg As String
Dim subj As String
Dim Offname As String
Dim Capt As String
Dim Repname As String, todayDate As String
Dim afiles As String
Dim rs As DAO.Recordset


nrecords = DCount("*", "OfficeInvoices")
recip = DLookup("OfficeEmail", "tblLogo", "ID=1")
Capt = DLookup("Captain", "ONCaptain", "Position=1")
msg = "Dear " & Offname & "," & vbNewLine & vbNewLine & _
"Please find attached the latest invoices for payment." & vbNewLine & vbNewLine & _
"Kind Regards" & vbNewLine & Capt
Offname = DLookup("OfficeRecipiant", "tblLogo", "ID=1")
subj = "Invoices for payment as of " & Format(Date, "Long Date")


If nrecords > 0 Then

todayDate = Format(Date, "MMDDYYYY")
Repname = Application.CurrentProject.Path & "InvoiceForOffice" & todayDate & ".pdf"
DoCmd.OutputTo acReport, "InvoiceForOffice", acFormatPDF, Repname, False


Set rs = CurrentDb.OpenRecordset("SELECT * FROM QueryFiles")

'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
    Do Until rs.EOF = True
        afiles = rs!InvoiceAddress
        rs.MoveNext
    Loop
      
    Call SendEmail(recip, subj, msg, True, , afiles)
    
DoCmd.SetWarnings False
DoCmd.OpenQuery "SentInvoices"
DoCmd.SetWarnings True
    
    
Else

  MsgBox "All invoices have already been exported", vbInformation, "No invoices to export"

End If

 
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up

End If


ErrorHandler:
    If Err.Number <> 0 And Err.Number <> 2501 Then
        MsgBox "Error: " & Err.Number & vbNewLine & Err.Description
        Exit Sub
    End If
    

    
End Sub

 

[tvanstiphout]

You'll need to use Outlook Automation (while it is still available) and the Attachments.Add method.

 

[theDBguy]

Do you have Option Explicit declared in your module? I can't tell what afiles was supposed to be. Maybe you're not using it correctly.

 

[mounty76]

Do you have Option Explicit declared in your module? I can't tell what afiles was supposed to be. Maybe you're not using it correctly.

No I don't have Option Explicit declared in the module. afiles is meant to be the URL to where the PDF is stored which needs to be attached to the email, but there are several PDFs that need to be attached, hence the loop....I would suggest there is a high likelyhood that I'm not using it correctly!! ;-)

 

[Gasman]

No I don't have Option Explicit declared in the module

You really should you know. expecially as you have been here all this time.

 

[Gasman]

See anything wrong with your code?
Do you walk your code and inspect what is generated? Debug.Print perhaps?

? Application.CurrentProject.Path
F:\Users\Paul\Documents

? Application.CurrentProject.Path & "InvoiceForOffice" & Date & ".pdf"
F:\Users\Paul\DocumentsInvoiceForOffice20/11/2023.pdf

 

[mounty76]

See anything wrong with your code?
Do you walk your code and inspect what is generated? Debug.Print perhaps?

? Application.CurrentProject.Path
F:\Users\Paul\Documents

? Application.CurrentProject.Path & "InvoiceForOffice" & Date & ".pdf"
F:\Users\Paul\DocumentsInvoiceForOffice20/11/2023.pdf

Thanks for that.... I see now

 

[Marshall Brooks]

Outlook Automation (while it is still available)

Could you clarify please?

 

[theDBguy]

Could you clarify please?

Assuming you're referring to the red text in your post. @tvanstiphout was talking about how MS removed the ability to automate Outlook New (that's the new Outlook application) from VBA code. So, while you still have Legacy Outlook, then you can automate it. But, when you switch over to Outlook New, then you will not be able to automate it anymore.

 

[Marshall Brooks]

I hadn't heard of Outlook New - is this going to be part of Office M365? And does this mean I won't be able to generate E-mails from Access using Outlook and VBA?

 

[theDBguy]

I hadn't heard of Outlook New - is this going to be part of Office M365? And does this mean I won't be able to generate E-mails from Access using Outlook and VBA?

It could very well become the main email client in M365, if it isn't already. I don't have M365 but when I upgraded to Win11, I ended up installing Outlook New. And yes, if you only have Outlook New, you won't be able to automate it using VBA. However, I imagine you would still be able to use SendObject though I haven't tried.

PS. See this previous thread for more info.

"New" Outlook breaks VBA?

I have had some reports within our company that switching to the "New Outlook" is breaking some of the VBA code I have written for our Access App. Specifically I have some code that generates and sends an email through Outlook that we have been using for years with no issue, lately I have been...

www.access-programmers.co.uk

 

[Marshall Brooks]

Well that just made my day ...

SendObject is VERY limited.

We use Outlook Automation a LOT!!! There are other ways to send E-mails, but I've never had a reason to test them or try them out.

 

[theDBguy]

Well that just made my day ...

SendObject is VERY limited.

We use Outlook Automation a LOT!!! There are other ways to send E-mails, but I've never had a reason to test them or try them out.

Lots of other people are in the same boat. Hopefully, MS will hear the outcry and do something about it. Good luck!

 

[Marshall Brooks]

Thanks. Doesn't make sense to me as a business model. I can understand replacing Outlook Web App with something better (which it sounds like Outlook New might be) and hoping that encourages people to upgrade to M365 (which is comparatively expensive).

I don't necessarily understand replacing your paying customers with a less capable app.

Not a great analogy, but it would be similar to Adobe saying "We're coming out with a better Adobe Reader program - and the good news is that if you bought the expensive full Acrobat suite to be able to edit PDF files and create Forms and interact with your documents via VBA, we're going to replace it with Reader and you won't be able to do any of that, but we'll still charge you the same subscription."

 

[Tom Robinson]

Your loop thru the recordset assigns rs!InvoiceAddress to afiles, but then does nothing with it until the loop is finished.
At that point, afiles holds the value for the last record only!

 

[Marshall Brooks]

Since SendEmail is in a separate module, I think the easiest way to handle this is with an array:
Dim i as Integer
I = 0
Do Until rs.EOF = True
afiles(i) = rs!InvoiceAddress ' Array will start at 0
rs.MoveNext
i = i+1
Loop

You might need to clear the array after the loop - maybe:
ReDim afiles(0)

Then in your Call SendE-mail Module:
With Mail Object
Dim i as Integer
If UBound(afiles) <> 0 Then
For I = 1 To UBound(afiles)
.Attachments.ADD afiles(i)
Next
End If
End With

Alternative would be NOT using the subroutine and having your E-mail generated and then opening the loop through the database in your E-mail routine and using Attachments.add Afile inside the loop there.