I would also like to automatically attach on the server to this email. Such a file stored such as \\servername\share\filename.pdf. Is it possible to do this?
Is it possible? Yes - but I don't believe you can do it using the .SendObject method on the report (to augment that output with additional attachments)
Instead, I would use .OutputTo to save a copy of the pdf locally (you can use SpecialFolders, or create a temp folder with your own code) Then I would use the Outlook.Application object to create a MailItem, attach your saved pdf, as well as any other attachments you want to add from the server. You can customise the e-mail output properly in this way.
When you're done, you can purge the temp copy of the pdf
Here is a fairly generic sub to generate an e-mail using Outlook.Application :
Code:
Public Sub CreateEMail(strSubject As String, strToRecipients As String, strCCRecipients As String, strBCCRecipients As String, strHTMLBody As String, arrAttachments As Variant)
Dim appOutlook As Object
Dim objMailItem As Object
Dim objRecipient As Object
Dim varSignature As Variant
Dim i As Long
Set appOutlook = CreateObject("Outlook.Application")
Set objMailItem = appOutlook.CreateItem(0) ' olMailItem
With objMailItem
.Display
appOutlook.ActiveWindow.WindowState = 1
varSignature = .HTMLBody
.Subject = strSubject
.To = strToRecipients
.CC = strCCRecipients
.BCC = strBCCRecipients
.HTMLBody = strHTMLBody & "<br><br>" & varSignature
For i = LBound(arrAttachments) To UBound(arrAttachments)
.Attachments.Add arrAttachments(i)
Next i
For Each objRecipient In .Recipients
objRecipient.Resolve
Next
.Close (0) ' olSave
.Display
End With
appOutlook.ActiveWindow.WindowState = 1
Set objMailItem = Nothing
Set appOutlook = Nothing
End Sub
And here's how you call it :
Code:
Public Sub DistributeReport()
Dim objTempFolder As Object
Dim strOutputPath As String
Dim strEMailBody As String
Set objTempFolder = CreateFolder(CurrentProject.Path, "\Temp Files\")
strOutputPath = objTempFolder.Path & "\MyPDF.pdf"
DoCmd.OpenReport "rptMyReport", acViewReport, , , acHidden
DoCmd.SetWarnings False
DoCmd.OutputTo acOutputReport, "rptMyReport", acFormatPDF, strOutputPath
DoCmd.SetWarnings True
DoCmd.Close acReport, "rptMyReport", acSaveNo
strEMailBody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & _
" size=" & Chr(34) & "11px" & Chr(34) & ">" & _
"Please find report attached" & _
"</font>"
Call CreateEMail("My Subject Line", _
"somebody@access.com", _
"somebodyelse@world.com", _
"somebodyfurther@forums.com", _
strEMailBody, _
Array(strOutputPath))
SetAttr strOutputPath, vbNormal
Kill strOutputPath
MsgBox "E-Mail Ready!", vbInformation
Set objTempFolder = Nothing
End Sub
Here is the CreateFolder function as well...
Code:
Public Function CreateFolder(ByVal strRoot As String, ByVal strFolder As String) As Object
Dim objFSO As Object
If Not Right(strRoot, 1) = "\" Then strRoot = strRoot & "\"
If Left(strFolder, 1) = "\" Then strFolder = Mid(strFolder, 2, Len(strFolder) - 1)
If Not Right(strFolder, 1) = "\" Then strFolder = strFolder & "\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strRoot & strFolder) Then
Set CreateFolder = objFSO.CreateFolder(strRoot & strFolder)
Else
Set CreateFolder = objFSO.GetFolder(strRoot & strFolder)
End If
Set objFSO = Nothing
End Function
Should be plenty here to get you started - customise it to suit your needs (you can add further attachments by adding them to the array that's passed when calling the CreateEMail sub...)
Sorry for the delay in getting back to this but I think I must be doing something wrong as I can't get this to work.
I have created a module called "CreateEMail" which is:
Code:
Public Sub CreateEMail(strSubject As String, strToRecipients As String, strCCRecipients As String, strBCCRecipients As String, strHTMLBody As String, arrAttachments As Variant)
Dim appOutlook As Object
Dim objMailItem As Object
Dim objRecipient As Object
Dim varSignature As Variant
Dim i As Long
Set appOutlook = CreateObject("Outlook.Application")
Set objMailItem = appOutlook.CreateItem(0) ' olMailItem
With objMailItem
.Display
appOutlook.ActiveWindow.WindowState = 1
varSignature = .HTMLBody
.Subject = strSubject
.To = strToRecipients
.CC = strCCRecipients
.BCC = strBCCRecipients
.HTMLBody = strHTMLBody & "<br><br>" & varSignature
For i = LBound(arrAttachments) To UBound(arrAttachments)
.Attachments.Add arrAttachments(i)
Next i
For Each objRecipient In .Recipients
objRecipient.Resolve
Next
.Close (0) ' olSave
.Display
End With
appOutlook.ActiveWindow.WindowState = 1
Set objMailItem = Nothing
Set appOutlook = Nothing
End Sub
I then copied the rest of the code into a module to be called when the user clicks on the required "email" button:
Code:
Private Sub Command122_Click()
Public Sub DistributeReport()
Dim objTempFolder As Object
Dim strOutputPath As String
Dim strEMailBody As String
Set objTempFolder = CreateFolder(CurrentProject.Path, "C:\Database\Temp\")
strOutputPath = objTempFolder.Path & "\MyPDF.pdf"
DoCmd.OpenReport "NewQuotation", acViewReport, , , acHidden
DoCmd.SetWarnings False
DoCmd.OutputTo acOutputReport, "NewQuotation", acFormatPDF, strOutputPath
DoCmd.SetWarnings True
DoCmd.Close acReport, "NewQuotation", acSaveNo
strEMailBody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & _
" size=" & Chr(34) & "11px" & Chr(34) & ">" & _
"Please find report attached" & _
"</font>"
Call CreateEMail("Our Quotation", _
"somebody@access.com, " & _
"somebodyelse@world.com, " & _
"somebodyfurther@forums.com, " & _
strEMailBody, & _
Array(strOutputPath))
SetAttr strOutputPath, vbNormal
Kill strOutputPath
MsgBox "E-Mail Ready!", vbInformation
Set objTempFolder = Nothing
End Sub
If I try to run the code I receive a "Compile Error: Epected End Sub" error message. I have also noticed that the following lines are red in the code:
You have a sub declaration inside another sub declaration, for a start - you can't do that :
Code:
[COLOR=red]Private Sub Command122_Click()[/COLOR]
[COLOR=red]Public Sub DistributeReport()[/COLOR]
You have two options - you can keep DistributeReport as a generic sub in a separate module, and call it when you click the command button :
Code:
Private Sub Command122_Click()
Call DistributeReport()
End Sub
Or you can just dump all the code into the click event of the command button :
Code:
Private Sub Command122_Click()
Dim objTempFolder As Object
Dim strOutputPath As String
Dim strEMailBody As String
Set objTempFolder = CreateFolder(CurrentProject.Path, "C:\Database\Temp\")
....
But you can't have a sub within a sub, if that makes sense?
Personally, I would go for the first option, but it's entirely up to you and how you want to design your database. If you plan on having similar command buttons on other forms, this will be a lot easier / less work-intensive.
To your aside :
As a slight aside, am I right in thinking that the line:
Code:
strOutputPath = objTempFolder.Path & "\MyPDF.pdf"
Attaches the external file "MyPDF.pdf" to the email?
Not entirely sure what you mean by 'external' - what the code does is create the PDF version of the report and saves it to the defined directory (for simplicity, I just save it to a temp folder which resides in the same location as the database, but you can change that to be whatever you want)
That specific line merely defines the path to which the (temporary) file is saved. objTempFolder is an FSO Folder object which is created (or validated) by the CreateFolder function (which checks the path to see if the folder already exists, creates it if it doesn't, and returns the Folder object)
...converts the report to PDF and saves it to that path
The act of attaching the file to the e-mail occurs within this loop in the CreateEMail function :
Code:
With objMailItem
...
For i = LBound(arrAttachments) To UBound(arrAttachments)
.Attachments.Add arrAttachments(i)
Next i
...
End WIth
...which loops through the array of attachments which you pass when calling the function. By doing it this way, you can have as many attachments as you like, simply by including them in the array at the point where you call the CreateEMail function :
Strongly advise you debug the code and step through it line by line with the appropriate watches to understand exactly what's going on at each step. Also, use Option Explicit at the top of all your modules and form code, to help you trap errant variables.
This text is also in red when I review the code so I think I've missed something.
I've tried running the "CreateEMail" module step-by-step however that still brings up the Syntax Error message highlighting the code in the "DistributeReport" module.
Note that originally I had the commas, which should be used to separate the parameters, inside the quotes for the email address strings. Which implies only 4 parameters being passed. The error is because the sub is expecting 6.
I've corrected the mistake in my previous posts, just in case anybody else tries that code without reading this far down - just in case you're reading back and notice it's changed and think you're going mad - you're not, it was my typo!
Just in case I've messed up somewhere else, my modules are:
Code:
Public Sub DistributeReport()
Dim objTempFolder As Object
Dim strOutputPath As String
Dim strEMailBody As String
Set objTempFolder = CreateFolder(CurrentProject.Path, "\Temp Files\")
strOutputPath = objTempFolder.Path & "\MyPDF.pdf"
DoCmd.OpenReport "NewQuotation", acViewPreview, , , acHidden
DoCmd.SetWarnings False
DoCmd.OutputTo acOutputReport, "NewQuotation", acFormatPDF, strOutputPath
DoCmd.SetWarnings True
DoCmd.Close acReport, "NewQuotation", acSaveNo
strEMailBody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & _
" size=" & Chr(34) & "11px" & Chr(34) & ">" & _
"Please find report attached" & _
"</font>"
Call CreateEMail("My Subject Line", _
"somebody@access.com", & _
"somebodyelse@world.com", & _
"somebodyfurther@forums.com", & _
strEMailBody, & _
Array(strOutputPath))
SetAttr strOutputPath, vbNormal
Kill strOutputPath
MsgBox "E-Mail Ready!", vbInformation
Set objTempFolder = Nothing
End Sub
Code:
Public Sub CreateEMail(strSubject As String, strToRecipients As String, strCCRecipients As String, strBCCRecipients As String, strHTMLBody As String, arrAttachments As Variant)
Dim appOutlook As Object
Dim objMailItem As Object
Dim objRecipient As Object
Dim varSignature As Variant
Dim i As Long
Set appOutlook = CreateObject("Outlook.Application")
Set objMailItem = appOutlook.CreateItem(0) ' olMailItem
With objMailItem
.Display
appOutlook.ActiveWindow.WindowState = 1
varSignature = .HTMLBody
.Subject = strSubject
.To = strToRecipients
.CC = strCCRecipients
.BCC = strBCCRecipients
.HTMLBody = strHTMLBody & "<br><br>" & varSignature
For i = LBound(arrAttachments) To UBound(arrAttachments)
.Attachments.Add arrAttachments(i)
Next i
For Each objRecipient In .Recipients
objRecipient.Resolve
Next
.Close (0) ' olSave
.Display
End With
appOutlook.ActiveWindow.WindowState = 1
Set objMailItem = Nothing
Set appOutlook = Nothing
End Sub
Code:
Public Function CreateFolder(ByVal strRoot As String, ByVal strFolder As String) As Object
Dim objFSO As Object
If Not Right(strRoot, 1) = "\" Then strRoot = strRoot & "\"
If Left(strFolder, 1) = "\" Then strFolder = Mid(strFolder, 2, Len(strFolder) - 1)
If Not Right(strFolder, 1) = "\" Then strFolder = strFolder & "\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strRoot & strFolder) Then
Set CreateFolder = objFSO.CreateFolder(strRoot & strFolder)
Else
Set CreateFolder = objFSO.GetFolder(strRoot & strFolder)
End If
Set objFSO = Nothing
End Function
Buddy - so sorry - I really shouldn't post up aircode like this, it's so difficult to get it right without the intelligence of the debugger. The ampersands shouldn't be there at all!
Sorry to be a pain but I've just got just one more thing I've found when playing with the code. There's nothing wrong with the code, I'm just not sure how to modify this one.
Using the old code, when the quotation was attached to the email generated by the database, the PDF was automatically renamed so its title would be "Our Quotation Ref: 123456 for 123 This Street - This Client reference 654321".
Using this code, the quotation is automatically named "MyPDF" or whatever I name it in the line:
Code:
strOutputPath = objTempFolder.Path & "\MyPDF.pdf"
I have tried playing around with this code to dynamically rename the pdf and think I'm almost there using the code:
