[X]My Assistant

[mike60smart]

Hi Everyone

Where would I place the following Public Function which I am trying to run from a Command Button on a Form.

The On Click Event for the Command Button is as follows:-

CODE

Private Sub cmdContract_Click()
SendEMails
End Sub

When I try to use the Command Button I get the following Error:-
 Error.PNG ( 3.16K )Number of downloads: 0


Any help appreciated.

The Function is as follows:-

CODE

Public Function SendEMails(strSubject As String, _
                     strMessage As String, _
                     Optional strAttachment1 As String, _
                     Optional strAttachment2 As String, _
                     Optional strAttachment3 As String)

10        On Error GoTo SendEMails_Error

20    If Me.Dirty Then Me.Dirty = False
      Dim strCrit As String
      Dim strDocname As String
      Dim strToWhom1 As String
      Dim strMsgBody As String
      Dim strSubject As String
      Dim strtxtName As String
      Dim strDir As String
      Dim strName As String

30     strDocname = "rptCurrentSale"
40     strSubject = "Sale Documents"
50     strToWhom1 = (Me![txtSellerEMail])
60     strMsgBody = "Find attached Sale details together with Mandate"
                  
      Dim objOutlook As Outlook.Application
      Dim objOutlookMsg As Outlook.MailItem
      Dim objOutlookRecip As Outlook.Recipient
      Dim objOutlookAttach As Outlook.Attachment
      'Set the variables
70    Set objOutlook = CreateObject("Outlook.Application")
80    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
90        With objOutlookMsg
100             objOutlookMsg.To = strToWhom1
110             objOutlookMsg.Subject = strSubject
120             objOutlookMsg.MsgBody = strMessage
130             objOutlookMsg.BodyFormat = olFormatHTML
140             objOutlookMsg.Importance = olImportanceHigh
150             objOutlookMsg.Attachments.Add strAttachment, olByRef, 1, "rptCurrentSale"
160   objOutlookMsg.Send
170   objOutlookMsg.Attachments.Add strAttachment, olByRef, 2, "rptSellerMandate"
180   objOutlookMsg.Send
190       End With
200       Set objOutlook = Nothing
          
210       DoCmd.OpenReport "rptCurrentSale", acPreview, , "[ContractID]=" & Me.ContractID

        

          
220       On Error GoTo 0
230       Exit Function

SendEMails_Error:

240       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure SendEMails, line " & Erl & "."

End Function

[June7]

SendEmails() function should be placed in a general module.

Provide inputs for required function arguments. Strings for subject and message are required arguments.

SendEmails("My Subject", "My Message")

[mike60smart]

Hi June

I have gone another route and found this code actually works and Previews the rptCurrentSale and also opens an EMail message but it only attached rptCurrentSale.

How would I modify this code to also attache rptMandateSeller ?

CODE

Private Sub cmdContract_Click()

10        On Error GoTo cmdContract_Click_Error
      Dim strDocName As String
      Dim strWhere As String
      Dim strToWhom As String
      Dim strMsgBody As String
      Dim strSubject As String

20    strDocName = "rptCurrentSale"
30    strWhere = "[ContractID]=" & Me!ContractID
40    strSubject = "Sale Letters"
50    strToWhom = Me![txtSellerEMail]
60    strMsgBody = "Find attached sale documentation."
70    If Me.Dirty Then Me.Dirty = False ' force a save

80    DoCmd.OpenReport strDocName, acPreview, , strWhere
90    DoCmd.SendObject acSendReport, "rptCurrentSale", acFormatPDF, strToWhom, , , strSubject, strMsgBody, True
100   DoCmd.SendObject acSendReport, "rptMandateSeller", acFormatPDF, strToWhom, , , strSubject, strMsgBody, True


          
110       On Error GoTo 0
120       Exit Sub

cmdContract_Click_Error:

130       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdContract_Click, line " & Erl & "."

End Sub

[theDBguy]

Hi Mike. If you want more than one attachment, I'm afraid you'll have to go back to your previous approach.

[mike60smart]

Hi theDbGuy

How would I change the first attempt??

I know that the Function is wrong in some way. Should this be placed in a Module as I have done or should it be created on the Form?

[June7]

If you want multiple attachments, including report(s), then must first open report(s) and OutputTo pdf then open email object and attach pdfs.
This post has been edited by June7: Nov 12 2019, 05:05 PM

[mike60smart]

Hi June

I only want to be able to EMail 2 Reports

[June7]

If you want them sent together in same email then advice stands.

This post has been edited by June7: Nov 13 2019, 01:36 AM

[MadPiet]

pass the reports as an array and loop through them?

How is the user specifying them in the interface?

if the report names is an array of strings, you could do

dim x as integer
for x = lbound(arrayName) to ubound(arrayName)
olkMsg.Attachments.Add(arrReports(x))
next x

[mike60smart]

Hi MadPiet, theDBguy & June

I have gone back to my original code and now when I run it I get the following error:-

 Error.PNG ( 38.21K )Number of downloads: 6


Any help appreciated.

This is my current Code:-

CODE

Private Sub cmdContract_Click()

10        On Error GoTo cmdContract_Click_Error

20        If Me.Dirty Then Me.Dirty = False
      Dim strCrit As String
      Dim strDocname As String
      Dim strToWhom1 As String
      Dim strMsgBody As String
      Dim strSubject As String
      Dim strtxtName As String
      Dim strDir As String
      Dim strName As String

30     strDocname = "rptCurrentSale"
40     strSubject = "Sale Documents"
50     strToWhom1 = (Me![txtSellerEMail])
60     strMsgBody = "Find attached Sale details together with Mandate"
      
70     DoCmd.OpenReport "rptCurrentSale", acPreview, , "[ContractID]=" & Me.ContractID
80     DoCmd.OpenReport "rptMandateSeller", acPreview, , "[ContractID]=" & Me.ContractID

      Dim objOutlook As Outlook.Application
      Dim objOutlookMsg As Outlook.MailItem
      Dim objOutlookRecip As Outlook.Recipient
      Dim objOutlookAttach As Outlook.Attachment
      'Set the variables
90    Set objOutlook = CreateObject("Outlook.Application")
100   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
110       With objOutlookMsg
120             objOutlookMsg.To = strToWhom1
130             objOutlookMsg.Subject = strSubject
140             objOutlookMsg.MsgBody = strMsgBody
150             objOutlookMsg.BodyFormat = olFormatHTML
160             objOutlookMsg.Importance = olImportanceHigh
170             objOutlookMsg.Attachments.Add strAttachment, olByRef, 1, "rptCurrentSale"
180             objOutlookMsg.Attachments.Add strAttachment, olByRef, 2, "rptMandateSeller"

190   objOutlookMsg.Send
200   objOutlookMsg.Attachments.Add strAttachment, olByRef, 1, "rptCurrentSale"

210   objOutlookMsg.Attachments.Add strAttachment, olByRef, 2, "rptSellerMandate"
220   objOutlookMsg.Send
230       End With
240       Set objOutlook = Nothing
  
250       On Error GoTo 0
260       Exit Sub

cmdContract_Click_Error:

270       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdContract_Click, line " & Erl & "."

End Sub

[theDBguy]

Hi Mike. I think you're getting an error because you haven't declared your variable and haven't assigned it the filepath to the file you want to attach to the email. I think you want to use the OutputTo method to create the file, so you can then attach it.

[MadPiet]

One thing you're doing in the Outlook code... You're mixing early and late binding.

Early binding uses
Dim olkApp as OUtlook.Application 'etc

Late binding uses
dim objOLKApp as OBJECT
and then
set objOLKApp = CreateObject("Outlook.Application")

With syntax is like this:

With OBJECT
.Property = <something>
.Method arg1, arg2
End With

There are examples on wherever AccessWeb went to.

[mike60smart]

Hi theDBGuy

I am not saving the Report as a File ?

Do I have to save the Report as a File? If yes how would I go about doing that?

[theDBguy]

Hi Mike. To "attach" a file to an email, the file must exist. So, yes, you'll have to create a file from your report to attach it to the email. To do that, you can use the OutputTo method.

[mike60smart]

Hi the DbGuy

Ok I have modified the code to include saving as a file but now getting this error:-

 Error.PNG ( 30.66K )Number of downloads: 2


Code is now:-

CODE

Private Sub cmdContract_Click()

10        On Error GoTo cmdContract_Click_Error

20        If Me.Dirty Then Me.Dirty = False
      Dim strCrit As String
      Dim strDocname As String
      Dim strToWhom1 As String
      Dim strMsgBody As String
      Dim strSubject As String
      Dim strtxtName As String
      Dim strDir As String
      Dim strName As String
      Dim strAttachment1 As String
      Dim strAttachment2 As String

30     strDocname = "rptCurrentSale"
40     strSubject = "Sale Documents"
50     strToWhom1 = (Me![txtSellerEMail])
60     strAttachment1 = "rptCurrentSale"
70     strAttachment2 = "rptMandateSeller"

80     If strToWhom1 <> "" Then
90     If Dir("c:\Contracts", vbDirectory) = "" Then MkDir "c:\Contracts"
100    DoCmd.OutputTo acOutputReport, "rptCurrentSale", acFormatPDF, "C:\Contracts\" & Format(Date, "yyyymmdd"), False
110    DoCmd.OutputTo acOutputReport, "rptMandateSeller", acFormatPDF, "C:\Contracts\" & Format(Date, "yyyymmdd"), False
120    End If
130    strMsgBody = "Find attached Sale details together with Mandate"
      
140    DoCmd.OpenReport "rptCurrentSale", acPreview, , "[ContractID]=" & Me.ContractID
150    DoCmd.OpenReport "rptMandateSeller", acPreview, , "[ContractID]=" & Me.ContractID

      Dim objOutlook As Outlook.Application
      Dim objOutlookMsg As Outlook.MailItem
      Dim objOutlookRecip As Outlook.Recipient
      Dim objOutlookAttach As Outlook.Attachment
      'Set the variables
160   Set objOutlook = CreateObject("Outlook.Application")
170   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
180       With objOutlookMsg
190             objOutlookMsg.To = strToWhom1
200             objOutlookMsg.Subject = strSubject
210             objOutlookMsg.MsgBody = strMsgBody
220             objOutlookMsg.BodyFormat = olFormatHTML
230             objOutlookMsg.Importance = olImportanceHigh
240             objOutlookMsg.Attachments.Add strAttachment1, olByRef, 1, "rptCurrentSale"
250             objOutlookMsg.Attachments.Add strAttachment2, olByRef, 2, "rptMandateSeller"

260   objOutlookMsg.Send
270   objOutlookMsg.Attachments.Add strAttachment, olByRef, 1, "rptCurrentSale"

280   objOutlookMsg.Attachments.Add strAttachment, olByRef, 2, "rptSellerMandate"
290   objOutlookMsg.Send
300       End With
310       Set objOutlook = Nothing
        
320       On Error GoTo 0
330       Exit Sub

cmdContract_Click_Error:

340       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdContract_Click, line " & Erl & "."

End Sub

[theDBguy]

That's not supported anymore. Try changing it to olByValue.

[mike60smart]

Hi theDBGuy

OK the Code is as shown below and it opens the 2 Reports.

It does not open an EMail Message.

It also generates this error:

 Error.PNG ( 3.97K )Number of downloads: 0


It creates 1 file only in the Folder but it has no associated extention??

CODE

Private Sub cmdContract_Click()

10        On Error GoTo cmdContract_Click_Error

20        If Me.Dirty Then Me.Dirty = False
      Dim strCrit As String
      Dim strDocname As String
      Dim strToWhom1 As String
      Dim strMsgBody As String
      Dim strSubject As String
      Dim strtxtName As String
      Dim strDir As String
      Dim strName As String
      Dim strAttachment1 As String
      Dim strAttachment2 As String

30     strDocname = "rptCurrentSale"
40     strSubject = "Sale Documents"
50     strToWhom1 = (Me![txtSellerEMail])
60     strAttachment1 = "rptCurrentSale"
70     strAttachment2 = "rptMandateSeller"
80     DoCmd.OpenReport "rptCurrentSale", acPreview, , "[ContractID]=" & Me.ContractID
90     DoCmd.OpenReport "rptMandateSeller", acPreview, , "[ContractID]=" & Me.ContractID

100    If strToWhom1 <> "" Then
110    If Dir("c:\Contracts", vbDirectory) = "" Then MkDir "c:\Contracts"
120    DoCmd.OutputTo acOutputReport, "rptCurrentSale", acFormatPDF, "C:\Contracts\" & Format(Date, "yyyymmdd"), False
130    DoCmd.OutputTo acOutputReport, "rptMandateSeller", acFormatPDF, "C:\Contracts\" & Format(Date, "yyyymmdd"), False
140    End If
150    strMsgBody = "Find attached Sale details together with Mandate"
      

      Dim objOutlook As Outlook.Application
      Dim objOutlookMsg As Outlook.MailItem
      Dim objOutlookRecip As Outlook.Recipient
      Dim objOutlookAttach As Outlook.Attachment
      'Set the variables
160   Set objOutlook = CreateObject("Outlook.Application")
170   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
180       With objOutlookMsg
190             objOutlookMsg.To = strToWhom1
200             objOutlookMsg.Subject = strSubject
210             objOutlookMsg.MsgBody = strMsgBody
220             objOutlookMsg.BodyFormat = olFormatHTML
230             objOutlookMsg.Importance = olImportanceHigh
240             objOutlookMsg.Attachments.Add strAttachment1, olByValue, 1, "rptCurrentSale"
250             objOutlookMsg.Attachments.Add strAttachment2, olByValue, 2, "rptMandateSeller"

260   objOutlookMsg.Send
270   objOutlookMsg.Attachments.Add strAttachment1, olByValue, 1, "rptCurrentSale"

280   objOutlookMsg.Attachments.Add strAttachment2, olByValue, 2, "rptSellerMandate"
290   objOutlookMsg.Send
300       End With
310       Set objOutlook = Nothing
        
320       On Error GoTo 0
330       Exit Sub

cmdContract_Click_Error:

340       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdContract_Click, line " & Erl & "."

End Sub

[theDBguy]

Hi Mike.

There's no file extension because you didn't give it any. Make sure to add ".pdf" to the filepath/filename argument of the OutputTo method. Also, it is only creating one file because you're using the same filename for both files; therefore, the second file is overwriting the first one.

Also, it doesn't open the email message because you're "sending" it right away. If you want to view it first, then use .Display, instead of .Send.

Which line is producing the error? Which line is highlighted when you go to Debug?

[mike60smart]

Hi theDBGuy

It highlights Line 210

[mike60smart]

Hi theDBGuy

Slow progress but still not there.Code is as below.

It generates the same error.

It does not open an email

And the 2 files are now created but my syntax is wrong as it looks like this

 files.PNG ( 4.23K )Number of downloads: 2

CODE

Private Sub cmdContract_Click()

10        On Error GoTo cmdContract_Click_Error

20        If Me.Dirty Then Me.Dirty = False
      Dim strCrit As String
      Dim strDocname As String
      Dim strToWhom1 As String
      Dim strMsgBody As String
      Dim strSubject As String
      Dim strtxtName As String
      Dim strDir As String
      Dim strName As String
      Dim strAttachment1 As String
      Dim strAttachment2 As String

30     strDocname = "rptCurrentSale"
40     strSubject = "Sale Documents"
50     strToWhom1 = (Me![txtSellerEMail])
60     strAttachment1 = "rptCurrentSale"
70     strAttachment2 = "rptMandateSeller"
80     DoCmd.OpenReport "rptCurrentSale", acPreview, , "[ContractID]=" & Me.ContractID
90     DoCmd.OpenReport "rptMandateSeller", acPreview, , "[ContractID]=" & Me.ContractID

100    If strToWhom1 <> "" Then
110    If Dir("c:\Contracts", vbDirectory) = "" Then MkDir "c:\Contracts"
120    DoCmd.OutputTo acOutputReport, "rptCurrentSale", acFormatPDF, "C:\Contracts\" & Format(Date, "yyyymmdd") & "_" & "Sale" & ".pdf, False"
130    DoCmd.OutputTo acOutputReport, "rptMandateSeller", acFormatPDF, "C:\Contracts\" & Format(Date, "yyyymmdd") & "_" & "Mandate" & ".pdf, False"
140    End If
150    strMsgBody = "Find attached Sale details together with Mandate"
      

      Dim objOutlook As Outlook.Application
      Dim objOutlookMsg As Outlook.MailItem
      Dim objOutlookRecip As Outlook.Recipient
      Dim objOutlookAttach As Outlook.Attachment
      'Set the variables
160   Set objOutlook = CreateObject("Outlook.Application")
170   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
180       With objOutlookMsg
190             objOutlookMsg.To = strToWhom1
200             objOutlookMsg.Subject = strSubject
210             objOutlookMsg.MsgBody = strMsgBody
220             objOutlookMsg.BodyFormat = olFormatHTML
230             objOutlookMsg.Importance = olImportanceHigh
240             objOutlookMsg.Attachments.Add strAttachment1, olByValue, 1, "rptCurrentSale"
250             objOutlookMsg.Attachments.Add strAttachment2, olByValue, 2, "rptMandateSeller"

260   objOutlookMsg.Display
270   objOutlookMsg.Attachments.Add strAttachment1, olByValue, 1, "rptCurrentSale"

280   objOutlookMsg.Attachments.Add strAttachment2, olByValue, 2, "rptSellerMandate"
290   objOutlookMsg.Display
300       End With
310       Set objOutlook = Nothing
        
320       On Error GoTo 0
330       Exit Sub

cmdContract_Click_Error:

340       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdContract_Click, line " & Erl & "."

End Sub