Email An Invoice

[bidbud68]

Hi I have a Sub that runs through my Reservation and Accounts tables (query) and prints out a report/invoice for that reservation. Then I wanted to email it to that person using the EM Address field in the same query.

This is the code that runs through my query :

Option Compare Database

   Sub Send_Monthly_Invoices()
   
   Dim dbsReservations As DAO.Database
   Dim rstInvoices As DAO.Recordset
   Dim strSQL As String
   Dim rdate As Date
   Dim strCondition1 As Variant
   Dim strEMRecipient As Variant
   
   'On Error GoTo ErrorHandler
   
   Set dbsReservations = CurrentDb
   
   rdate = InputBox("Enter Date")
   
   strCondition1 = "#" & rdate & "#"
   
   strSQL = "SELECT Reservations.ReservationID, Accounts.Item, Customers.EMAddress, * FROM Customers INNER JOIN (Accounts INNER JOIN Reservations ON Accounts.ReservationID = Reservations.ReservationID) ON Customers.CompanyName = Reservations.Customer WHERE (((Accounts.Date) = #19/09/2012#)) ORDER BY Accounts.Date;"
   Set rstInvoices = dbsReservations.OpenRecordset(strSQL, dbOpenDynaset)
   
   With rstInvoices
     Do Until .EOF
         DoCmd.OpenReport "Invoices For Month End Emailing", acViewNormal, , "Reservations.ReservationID=" & rstInvoices![Reservations.ReservationID]
         DoCmd.OpenReport "Booking Confirmation", acViewNormal, , "Reservations.ReservationID=" & rstInvoices![Reservations.ReservationID]
         'DoCmd.OpenReport "Send Invoice Email", acViewNormal, , "Reservations.ReservationID=" & rstInvoices![Reservations.ReservationID]
         Application.Run "SendInvoiceEmail", strEmailRecipient = rstInvoices![EMAddress]
     Loop
   End With

   rstInvoices.Close
   dbsReservations.Close
   
   Set rstInvoices = Nothing
   Set dbsReservations = Nothing

   Exit Sub

   'ErrorHandler:
   '  MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description

   End Sub

And this is the code that I need to pass the strEmailRecipient to :

Option Explicit

  Sub SendInvoiceEmail(Optional AttachmentPath)
   Dim objOutlook As Outlook.Application
   Dim objOutlookMsg As Outlook.MailItem
   Dim objOutlookRecip As Outlook.Recipient
   Dim objOutlookAttach As Outlook.Attachment
   Dim strEmailRecipient As String
      
   ' Create the Outlook session.
   Set objOutlook = CreateObject("Outlook.Application")

   ' Create the message.
   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

   With objOutlookMsg
      ' Add the To recipient(s) to the message.
      If IsNull(strEmailRecipient) Then
        Set objOutlookRecip = .Recipients.Add("emailaddress")
        Else
        Set objOutlookRecip = .Recipients.Add(strEmailRecipient)
      End If
      objOutlookRecip.Type = olTo

      ' Add the CC recipient(s) to the message.
      Set objOutlookRecip = .Recipients.Add("emailaddress")
      objOutlookRecip.Type = olCC

      ' Set the Subject, Body, and Importance of the message.
      .Subject = "Invoice"
      .Body = "Dear Accounts. Please find your invoice attached. Kind Regards BCA." & vbCrLf & vbCrLf
      .Importance = olImportanceHigh  'High importance

      ' Add attachments to the message.
      Set objOutlookAttach = .Attachments.Add("C:\Users\User\My Documents\Blue Chip Accommodation\PDF Docs\Invoice.pdf")
      Set objOutlookAttach = .Attachments.Add("C:\Users\User\My Documents\Blue Chip Accommodation\PDF Docs\Booking Confirmation.pdf")
      
      ' Resolve each Recipient's name.
      For Each objOutlookRecip In .Recipients
         objOutlookRecip.Resolve
         If Not objOutlookRecip.Resolve Then
         objOutlookMsg.Display
      End If
      Next
      .Send

   End With
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
End Sub

The above code hasnt picked up the variable using the OpenReport like the other two Do.Cmd's have so I tried Application.Run but that also wont pass variables. Not sure if I need a public variable or if I need to do the Do.Cmd.OpenReport "SendInvoicEmail" with proper syntax to pass it.

 

[Peter Reid]

Your SendInvoiceEmail subroutine is assigning the email address to the optional variable called AttachmentPath.

One way to fix it would be to change the line

Sub SendInvoiceEmail(Optional AttachmentPath)

to

Sub SendInvoiceEmail(strEmailRecipient as string, Optional AttachmentPath)

and then remove the line;

Dim strEmailRecipient As String

Edit: I haven't looked at all of the code so there may be other things wrong!

 

[bidbud68]

Hi thanks for the reply.

I changed that and it seems that the email address from Send_Monthly_Invoices which is correct is being brought in as a 0 in SendInvoiceEmail.

 

[Peter Reid]

Sorry, you also need to amend a line in Send_Monthly_Invoices

Application.Run "SendInvoiceEmail", strEmailRecipient = rstInvoices![EMAddress]

should be changed to

Application.Run "SendInvoiceEmail", rstInvoices![EMAddress]

It was passing 0 as strEmailRecipient was not equal to rstInvoices![EMAddress]