kmoyer9717
asked on
Automating access into email body
I have a button on a form that when clicked uses an access report to create a html file and pastes it into a draft email body. Works great.
The issue I am trying to resolve is when the report is copied from access to the html file it is not staying formatted.
Attached is my button click code. I have been playing with this and not sure whether I need to change something in my code or the report or html file.
Any help is appreciated.
Kelly
The issue I am trying to resolve is when the report is copied from access to the html file it is not staying formatted.
Attached is my button click code. I have been playing with this and not sure whether I need to change something in my code or the report or html file.
Private Sub Cmd_EmailPoss_Click()
Dim db As Database
Dim rs As Recordset
Dim ClientEmail As String
Dim DisplayMsg As Boolean
Dim AttachmentPath As String
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objOutlookExplorers As Outlook.Explorers
Dim myarray() As String
Dim myaddresses() As String
Dim x As Integer
Dim fs As Object
Dim BuiltPath As String
Dim response As Integer
Dim WasOpen As Boolean
Dim strWhere As String
Dim FormatValue As String
Dim stdocname As String
'This gets the current record
If Me.Dirty Then 'Save any edits.
Me.Dirty = False
End If
If Me.NewRecord Then 'Check there is a record to print
MsgBox "Select a record to print"
Else
strWhere = "[ID] = " & Me.[ID]
DoCmd.OpenReport "Rpt_POSS_Email_Letter", acViewPreview, , strWhere
End If
'This exports the letter to HTML
FormatValue = acFormatHTML
stdocname = "Rpt_POSS_Email_Letter"
DoCmd.OutputTo acOutputReport, stdocname, FormatValue, "c:\temp\RptEmail.Html", True
'This creates the email
DisplayMsg = True
AttachmentPath = "c:\Temp\RptEmail.Html"
MsgBox "The email is about to be created!"
Set objOutlook = GetObject(, "Outlook.Application")
'MsgBox Err.Number & " " & Err.Description
If Err.Number = 429 Then 'Outlook was already open
Err.Clear
WasOpen = False
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Else
WasOpen = True
End If
Dim ns As Outlook.Namespace
Dim Folder As Outlook.MAPIFolder
Set ns = objOutlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
Set objOutlookExplorers = objOutlook.Explorers
If WasOpen = False Then
objOutlook.Explorers.Add Folder
Folder.Display
'done opening
End If
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
If Me.[Txt_EMAIL] Like "*@*" Then
ClientEmail = Me.[Txt_EMAIL]
Else
ClientEmail = ""
End If
'My [Client Email] field is memo, and multiple emails separated by semi-colons are stored in it
If Nz(ClientEmail, "") <> "" Then
' Add the To recipient(s) to the message.
myaddresses = Split(ClientEmail, ";")
For x = LBound(myaddresses) To UBound(myaddresses)
Set objOutlookRecip = .Recipients.Add(myaddresses(x))
objOutlookRecip.Type = olTo
Next x
End If
'added all the recipients with the above loop
'can't do this, the mail never gets sent
'Add the from recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("me@mydomain.com")
objOutlookRecip.Type = olOriginator
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("FIU.Mailbox@LPL.com")
objOutlookRecip.Type = olCC
' Set the Subject, Body, and Importance of the message.
.Subject = Me.FIRST_NAME + " " + Me.LAST_NAME
'to paste a document's contents in you need HTML formatted email messages
'to paste a document's contents in you need HTML formatted email messages
.BodyFormat = olFormatHTML
Dim ts As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.GetFile("c:\Temp\RptEmail.Html").OpenAsTextStream(1, -2)
.BodyFormat = olFormatHTML
.HTMLBody = .HTMLBody & ts.ReadAll
' Save the message for review before sending?
.Save
Set objOutlook = Nothing
End With
End Sub
Any help is appreciated.
Kelly
Not to take away from JDettman's comment but if you must have the output in html you can construct the page using a VBA routine and the recordsource for the report. I've done this to construct specifically formatted web pages from Access.
OM Gang
OM Gang
ASKER
Thanks for responding.
Ok so what I did so far is saved my report as a .PDF, Changed my output code file name from html to pdf and the attachment path to the .pdf file.
I am not sure what else I am needing to copy the .pdf to my email but I am getting an error when outputting the file to PDF.
"runtime error 2282 the format in which you are attempting to output the current
object is not available. "
I think I may need a little more guidance here.
Ok so what I did so far is saved my report as a .PDF, Changed my output code file name from html to pdf and the attachment path to the .pdf file.
I am not sure what else I am needing to copy the .pdf to my email but I am getting an error when outputting the file to PDF.
"runtime error 2282 the format in which you are attempting to output the current
object is not available. "
I think I may need a little more guidance here.
What version of Access? Access 2007 and later had pdf format native. Earlier versions did not and require additional steps.
OM Gang
OM Gang
ASKER
Hi omgang
I don't have to use html. Just whatever gives me the end result. I am very close. Just not quite there.
The report was created to get rid of a word mail merge and autmate the copy paste into the body of an email.
Can you give me a lttle more info on "construct the page using a VBA routine and the recordsource for the report. I've done this to construct specifically formatted web pages from Access."?
All,
I appreciate the help.
I don't have to use html. Just whatever gives me the end result. I am very close. Just not quite there.
The report was created to get rid of a word mail merge and autmate the copy paste into the body of an email.
Can you give me a lttle more info on "construct the page using a VBA routine and the recordsource for the report. I've done this to construct specifically formatted web pages from Access."?
All,
I appreciate the help.
ASKER
2007
<<I am not sure what else I am needing to copy the .pdf to my email but I am getting an error when outputting the file to PDF.>>
You would not copy it into the body, but send the file as an attachment.
JimD.
You would not copy it into the body, but send the file as an attachment.
JimD.
BTW, it would be:
.Attachments.Add (<file path here>)
JimD.
.Attachments.Add (<file path here>)
JimD.
ASKER
I dont want the file as an attachment. I want to keep it as the body of the email.
My original code actually pastes the html file directly into the body of the email. This part is working perfectly except I lose a little formatting.
My issue is how can I keep my formatting? It seems to happen while saving the output file to HTML. I am ok to use another format to paste into the email if I must but not Ok to use attachments. I am thinking that I have to keep it in HTML but not sure what I need to modify. (report, email, vba code on button click etc.)
My original code actually pastes the html file directly into the body of the email. This part is working perfectly except I lose a little formatting.
My issue is how can I keep my formatting? It seems to happen while saving the output file to HTML. I am ok to use another format to paste into the email if I must but not Ok to use attachments. I am thinking that I have to keep it in HTML but not sure what I need to modify. (report, email, vba code on button click etc.)
<<My issue is how can I keep my formatting? It seems to happen while saving the output file to HTML. I am ok to use another format to paste into the email if I must but not Ok to use attachments.>>
Sorry, don't have anything else to offer. As OM Gang said, to avoid the formatting issues, you'd need to write code to generate the html required. That's not going to be a trival task depending on what the page looks like. For an idea of what that might look like, see the attached code.
Other then that, it's an attachment...
JimD.
Sorry, don't have anything else to offer. As OM Gang said, to avoid the formatting issues, you'd need to write code to generate the html required. That's not going to be a trival task depending on what the page looks like. For an idea of what that might look like, see the attached code.
Other then that, it's an attachment...
JimD.
230 strMailMessage = "<!DOCTYPE HTML PUBLIC " & Chr(34) & "-//W3C//DTD HTML 4.0 Transitional//EN" & Chr(34) & ">" & vbCrLf
240 strMailMessage = strMailMessage & "<HTML><HEAD>" & vbCrLf
250 strMailMessage = strMailMessage & "<META http-equiv=Content-Type content=" & Chr(34) & "text/html; charset=iso-8859-1" & Chr(34) & ">" & vbCrLf
260 strMailMessage = strMailMessage & "<META content=" & Chr(34) & "MSHTML 6.00.2800.1126" & Chr(34) & " name=GENERATOR></HEAD>" & vbCrLf
270 strMailMessage = strMailMessage & "<BODY>" & vbCrLf
280 strMailMessage = strMailMessage & "<HR>" & vbCrLf
290 strMailMessage = strMailMessage & "945's for the following orders are overdue: " & vbCrLf
300 strMailMessage = strMailMessage & "<UL><PRE>" & vbCrLf
310 strMailMessage = strMailMessage & strOrderList
320 strMailMessage = strMailMessage & "</UL></PRE>" & vbCrLf
330 strMailMessage = strMailMessage & "<HR>" & vbCrLf
340 strMailMessage = strMailMessage & "</BODY></HTML>" & vbCrLf
Here's a routine I used to create an html web page listing particular items in inventory. It should give you the basic idea. I did this years ago and used in-line styles for everything. Since we're creating the page from scratch there's nothing to prevent us from adding styles in the head section. When I first did this, I started with an html page that was formatted exactly the way I wanted and then built the VBA routine to construct the page exactly that way.
OM Gang
Public Function Files_html()
'this function generates an html web page for Files, Lateral
'& Vertical (Files.html)
Dim db As Database
Dim rs As Recordset
Dim strQT As String
Dim dtCurrent As Date
strQT = Chr$(34) 'sets variable to a single quotation mark (ie. " )
dtCurrent = Now() 'sets variable to current date and time
Set db = CurrentDb
Set rs = db.OpenRecordset("qryFiles ") 'source query for data
'destination file for output
Open "c:\temp\Files.html" For Output As #1
'begin build of web page
Print #1, "<html>"
'header info. for page
Print #1, "<head>"
Print #1, "<meta http-equiv=" & strQT & "Content-Language" & strQT & " content=" & strQT & "en-us" & strQT & ">"
Print #1, "<meta http-equiv=" & strQT & "Content-Type" & strQT & " content=" & strQT & "text/html; charset=windows-1252" & strQT & ">"
Print #1, "<meta name=" & strQT & "keywords" & strQT & " content=" & strQT & "steelcase, hon, shaw walker, gf, general fireproofing, file, files," _
& " filing, filing cabinet, file cabinet, lateral file, vertical file" & strQT & ">"
Print #1, "<title>File Cabinets, Lateral & Vertical - Available Inventory</title>"
Print #1, "</head>"
Print #1, "<body>"
'page header and also date/time stamp
Print #1, Tab(1); "<p align=" & strQT & "center" & strQT & " style=" & strQT & "margin-top: 0; margin-bottom: 0" & strQT & "><b><font size=" & strQT & "5" & strQT & " face=" & strQT _
& "Georgia" & strQT & " color=" & strQT & "#0033CC" & strQT & ">Available Inventory: Files, Lateral & Vertical</font></b></p>"
Print #1, Tab(1); "<p align=" & strQT & "center" & strQT & " style=" & strQT & "margin-top: 0; margin-bottom: 0" & strQT & "><b><font size=" & strQT & "4" & strQT & " face=" _
& strQT & "Georgia" & strQT & " color=" & strQT & "#0033CC" & strQT & ">F.O.B. Atlanta, Georgia</font></b></p>"
Print #1, Tab(1); "<p align=" & strQT & "center" & strQT & " style=" & strQT & "margin-top: 0; margin-bottom: 0" & strQT & "><font face=" & strQT & "Georgia" & strQT & " color=" _
& strQT & "#0033CC" & strQT & " size=" & strQT & "3" & strQT & "><b>Updated: " & dtCurrent & " PST</b></font></p>"
Print #1, Tab(2); "<table border=" & strQT & "1" & strQT & " width=" & strQT & "860" & strQT & " bordercolor=" & strQT & "#FFFFFF" & strQT & ">"
Print #1, Tab(3); "<tr>"
Print #1, Tab(4); "<td width=" & strQT; "430" & strQT & " height=" & strQT & "20" & strQT & "><p align=" & strQT & "left" & strQT & "><font face=" & strQT & "Georgia" _
& strQT & " color=" & strQT & "#0033CC" & strQT & " size=" & strQT & "3" & strQT & "><b> </b></font></td >"
Print #1, Tab(4); "<td width=" & strQT; "430" & strQT & " height=" & strQT & "20" & strQT & "><p align=" & strQT & "right" & strQT & "><font face=" & strQT & "Georgia" _
& strQT & " color=" & strQT & "#0033CC" & strQT & " size=" & strQT & "3" & strQT & "><b><a href=" & strQT & "download.php?filename=fil es.xls" & strQT _
& ">Excel Spreadsheet</a></b></font> </td>"
Print #1, Tab(3); "</tr>"
Print #1, Tab(2); "</table>"
'Print #1, Tab(1); "<p align=" & strQT & "right" & strQT & " style=" & strQT & "margin-top: 0; margin-bottom: 0" & strQT & "><font face=" & strQT & "Georgia" & strQT & " color=" _
' & strQT & "#0033CC" & strQT & " size=" & strQT & "3" & strQT & "><b><a href=" & strQT & "download.php?filename=sca venir.xls" & strQT & ">Excel Spreadsheet</a></b></font> </p>"
Print #1, Tab(1); "<p align=" & strQT & "center" & strQT & " style=" & strQT & "margin-top: 0; margin-bottom: 0" & strQT & "> </p>"
'define table for query output
Print #1, Tab(2); "<table border=" & strQT & "1" & strQT & " width=" & strQT & "840" & strQT & " bordercolor=" & strQT & "#FFFFFF" & strQT & ">"
'first row; column heads
Print #1, Tab(3); "<tr>"
Print #1, Tab(4); "<td width=" & strQT & "50" & strQT & " height=" & strQT & "15" & strQT & "><p align=" & strQT & "center" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Qty</b></font></td>"
Print #1, Tab(4); "<td width=" & strQT & "100" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Model</b></font></td> "
Print #1, Tab(4); "<td width=" & strQT & "300" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Description</b></font ></td>"
Print #1, Tab(4); "<td width=" & strQT & "75" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Color</b></font></td> "
Print #1, Tab(4); "<td width=" & strQT & "75" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Color</b></font></td> "
Print #1, Tab(4); "<td width=" & strQT & "90" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b></b></font></td>"
Print #1, Tab(4); "<td width=" & strQT & "150" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Category</b></font></ td>"
Print #1, Tab(3); "</tr>"
'this loop creates a new row in the table for each record in the query
rs.MoveFirst
Do Until rs.EOF
Print #1, Tab(3); "<tr>"
Print #1, Tab(4); "<td width=" & strQT & "50" & strQT & " height=" & strQT & "15" & strQT & "><p align=" & strQT & "center" & strQT & "><font size=" & strQT & "2" & strQT & ">" & rs![Qty] & "</font></td>"
Print #1, Tab(4); "<td width=" & strQT & "100" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & ">" & rs![Model] & "</font></td>"
Print #1, Tab(4); "<td width=" & strQT & "300" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & ">" & rs![Description] & "</font></td>"
Print #1, Tab(4); "<td width=" & strQT & "75" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & ">" & rs![Color_1] & "</font></td>"
Print #1, Tab(4); "<td width=" & strQT & "75" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & ">" & rs![Color_2] & "</font></td>"
Print #1, Tab(4); "<td width=" & strQT & "90" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "></font></td>"
Print #1, Tab(4); "<td width=" & strQT & "150" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "1" & strQT & ">" & rs![Category] & "</font></td>"
Print #1, Tab(3); "</tr>"
rs.MoveNext
Loop
Print #1, Tab(2); "</table>" 'table close tag
'inserts logo image at bottom of web page
Print #1, "<p align=" & strQT & "center" & strQT & "><a href=" & strQT & strHyperlink & strQT & "><img border=" & strQT & "0" & strQT & " src=" & strQT & strImageFile & strQT & " width=" & strQT & "287" & strQT & " height=" & strQT & "52" & strQT & "></a></p>"
Print #1, "</body>" 'close tags
Print #1, "</html>"
Close #1 'close destination file
'clear object variables
rs.Close
Set rs = Nothing
Set db = Nothing
End Function
OM Gang
Public Function Files_html()
'this function generates an html web page for Files, Lateral
'& Vertical (Files.html)
Dim db As Database
Dim rs As Recordset
Dim strQT As String
Dim dtCurrent As Date
strQT = Chr$(34) 'sets variable to a single quotation mark (ie. " )
dtCurrent = Now() 'sets variable to current date and time
Set db = CurrentDb
Set rs = db.OpenRecordset("qryFiles
'destination file for output
Open "c:\temp\Files.html" For Output As #1
'begin build of web page
Print #1, "<html>"
'header info. for page
Print #1, "<head>"
Print #1, "<meta http-equiv=" & strQT & "Content-Language" & strQT & " content=" & strQT & "en-us" & strQT & ">"
Print #1, "<meta http-equiv=" & strQT & "Content-Type" & strQT & " content=" & strQT & "text/html; charset=windows-1252" & strQT & ">"
Print #1, "<meta name=" & strQT & "keywords" & strQT & " content=" & strQT & "steelcase, hon, shaw walker, gf, general fireproofing, file, files," _
& " filing, filing cabinet, file cabinet, lateral file, vertical file" & strQT & ">"
Print #1, "<title>File Cabinets, Lateral & Vertical - Available Inventory</title>"
Print #1, "</head>"
Print #1, "<body>"
'page header and also date/time stamp
Print #1, Tab(1); "<p align=" & strQT & "center" & strQT & " style=" & strQT & "margin-top: 0; margin-bottom: 0" & strQT & "><b><font size=" & strQT & "5" & strQT & " face=" & strQT _
& "Georgia" & strQT & " color=" & strQT & "#0033CC" & strQT & ">Available Inventory: Files, Lateral & Vertical</font></b></p>"
Print #1, Tab(1); "<p align=" & strQT & "center" & strQT & " style=" & strQT & "margin-top: 0; margin-bottom: 0" & strQT & "><b><font size=" & strQT & "4" & strQT & " face=" _
& strQT & "Georgia" & strQT & " color=" & strQT & "#0033CC" & strQT & ">F.O.B. Atlanta, Georgia</font></b></p>"
Print #1, Tab(1); "<p align=" & strQT & "center" & strQT & " style=" & strQT & "margin-top: 0; margin-bottom: 0" & strQT & "><font face=" & strQT & "Georgia" & strQT & " color=" _
& strQT & "#0033CC" & strQT & " size=" & strQT & "3" & strQT & "><b>Updated: " & dtCurrent & " PST</b></font></p>"
Print #1, Tab(2); "<table border=" & strQT & "1" & strQT & " width=" & strQT & "860" & strQT & " bordercolor=" & strQT & "#FFFFFF" & strQT & ">"
Print #1, Tab(3); "<tr>"
Print #1, Tab(4); "<td width=" & strQT; "430" & strQT & " height=" & strQT & "20" & strQT & "><p align=" & strQT & "left" & strQT & "><font face=" & strQT & "Georgia" _
& strQT & " color=" & strQT & "#0033CC" & strQT & " size=" & strQT & "3" & strQT & "><b> </b></font></td
Print #1, Tab(4); "<td width=" & strQT; "430" & strQT & " height=" & strQT & "20" & strQT & "><p align=" & strQT & "right" & strQT & "><font face=" & strQT & "Georgia" _
& strQT & " color=" & strQT & "#0033CC" & strQT & " size=" & strQT & "3" & strQT & "><b><a href=" & strQT & "download.php?filename=fil
& ">Excel Spreadsheet</a></b></font>
Print #1, Tab(3); "</tr>"
Print #1, Tab(2); "</table>"
'Print #1, Tab(1); "<p align=" & strQT & "right" & strQT & " style=" & strQT & "margin-top: 0; margin-bottom: 0" & strQT & "><font face=" & strQT & "Georgia" & strQT & " color=" _
' & strQT & "#0033CC" & strQT & " size=" & strQT & "3" & strQT & "><b><a href=" & strQT & "download.php?filename=sca
Print #1, Tab(1); "<p align=" & strQT & "center" & strQT & " style=" & strQT & "margin-top: 0; margin-bottom: 0" & strQT & "> </p>"
'define table for query output
Print #1, Tab(2); "<table border=" & strQT & "1" & strQT & " width=" & strQT & "840" & strQT & " bordercolor=" & strQT & "#FFFFFF" & strQT & ">"
'first row; column heads
Print #1, Tab(3); "<tr>"
Print #1, Tab(4); "<td width=" & strQT & "50" & strQT & " height=" & strQT & "15" & strQT & "><p align=" & strQT & "center" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Qty</b></font></td>"
Print #1, Tab(4); "<td width=" & strQT & "100" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Model</b></font></td>
Print #1, Tab(4); "<td width=" & strQT & "300" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Description</b></font
Print #1, Tab(4); "<td width=" & strQT & "75" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Color</b></font></td>
Print #1, Tab(4); "<td width=" & strQT & "75" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Color</b></font></td>
Print #1, Tab(4); "<td width=" & strQT & "90" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b></b></font></td>"
Print #1, Tab(4); "<td width=" & strQT & "150" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "><b>Category</b></font></
Print #1, Tab(3); "</tr>"
'this loop creates a new row in the table for each record in the query
rs.MoveFirst
Do Until rs.EOF
Print #1, Tab(3); "<tr>"
Print #1, Tab(4); "<td width=" & strQT & "50" & strQT & " height=" & strQT & "15" & strQT & "><p align=" & strQT & "center" & strQT & "><font size=" & strQT & "2" & strQT & ">" & rs![Qty] & "</font></td>"
Print #1, Tab(4); "<td width=" & strQT & "100" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & ">" & rs![Model] & "</font></td>"
Print #1, Tab(4); "<td width=" & strQT & "300" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & ">" & rs![Description] & "</font></td>"
Print #1, Tab(4); "<td width=" & strQT & "75" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & ">" & rs![Color_1] & "</font></td>"
Print #1, Tab(4); "<td width=" & strQT & "75" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & ">" & rs![Color_2] & "</font></td>"
Print #1, Tab(4); "<td width=" & strQT & "90" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "2" & strQT & "></font></td>"
Print #1, Tab(4); "<td width=" & strQT & "150" & strQT & " height=" & strQT & "15" & strQT & "><font size=" & strQT & "1" & strQT & ">" & rs![Category] & "</font></td>"
Print #1, Tab(3); "</tr>"
rs.MoveNext
Loop
Print #1, Tab(2); "</table>" 'table close tag
'inserts logo image at bottom of web page
Print #1, "<p align=" & strQT & "center" & strQT & "><a href=" & strQT & strHyperlink & strQT & "><img border=" & strQT & "0" & strQT & " src=" & strQT & strImageFile & strQT & " width=" & strQT & "287" & strQT & " height=" & strQT & "52" & strQT & "></a></p>"
Print #1, "</body>" 'close tags
Print #1, "</html>"
Close #1 'close destination file
'clear object variables
rs.Close
Set rs = Nothing
Set db = Nothing
End Function
Constructing HTML email messages in code is very complicated and time-consuming. Here is an example:
Public Sub CreateEmails()
'Created by Helen Feddema 31-Jan-2010
'Last modified by Helen Feddema 7-Feb-2010
On Error GoTo ErrorHandler
Dim appOutlook As New Outlook.Application
Dim dtePickup As Date
Dim dteSold As Date
Dim msg As Outlook.MailItem
Dim rstAll As DAO.Recordset
Dim rstSingle As DAO.Recordset
Dim strBody As String
Dim strCompany As String
Dim strEMail As String
Dim strFCFNumber As String
Dim strGrade1 As String
Dim strGrade2 As String
Dim strHeader As String
Dim strHTMLBody As String
Dim strLine1 As String
Dim strLine2 As String
Dim strNotes As String
Dim strQueryAll As String
Dim strQuerySingle As String
Dim strSignature As String
Dim strSubject As String
Set dbs = CurrentDb
strQueryAll = "qrySendEmails"
Set rstAll = dbs.OpenRecordset(strQueryAll)
strQuerySingle = "qryTempEmail"
strSignature = "</table><br><br><font face='Book Antiqua', size=5>" _
& "<align='left'><u>John Doe</u></font><br>" _
& "<font face='Arial', size=3><br>" _
& "VP of Sales and Marketing<br>" _
& "JD Inc.<br>" _
& "Ph: 555-112-9601<br>" _
& "Fx: 555-112-9422<br>"
Debug.Print "Signature: "; strSignature
Do While Not rstAll.EOF
'Create filtered recordset for this customer
lngSupplierID = Nz(rstAll![CustomerID])
If lngSupplierID <> 0 Then
strSQL = "SELECT * FROM " & strQueryAll & " WHERE " _
& "[CustomerID] = " & lngSupplierID & ";"
End If
Debug.Print "SQL for " & strQuerySingle & ": " & strSQL
lngCount = CreateAndTestQuery(strQuerySingle, strSQL)
Debug.Print "No. of items found: " & lngCount
If lngCount = 0 Then
strPrompt = "No records found; canceling"
strTitle = "Canceling"
MsgBox strPrompt, vbOKOnly + vbCritical, strTitle
GoTo ErrorHandlerExit
Else
'Create email for this customer
strHTMLBody = ""
strHeader = "<font face='Arial', size=3>" _
& "Please schedule the following: <br><br>" _
& "<table width='791' border='1'>" _
& " <tr>" _
& " <td width='283'height='26' nowrap valign='bottom'" _
& "align='left'><font face='Arial', size=3><strong>Grade</strong></font></td>" _
& " <td width='127' height='26'nowrap valign='bottom'" _
& "align='left'><font face='Arial', size=3><strong>FCF Pickup #</strong></font>" _
& " <td width='144'height='26' nowrap valign='bottom'" _
& "align='left'><font face='Arial', size=3><strong>Pickup Date</strong></font></td>" _
& " <td width='237'height='26' nowrap valign='bottom'" _
& "align='left'><font face='Arial', size=3><strong>Notes</strong></font></td>" _
& " </tr>"
Set rstSingle = dbs.OpenRecordset(strQuerySingle)
strEMail = Nz(rstSingle![EmailAddress])
strCompany = Nz(rstSingle![strCompany])
strSubject = "Loads for " & strCompany
'Create email for this customer
Set msg = appOutlook.CreateItem(olMailItem)
msg.To = strEMail
msg.Subject = strSubject
msg.BodyFormat = olFormatHTML
'Process loads per customer
Debug.Print "Processing load(s) for " & strCompany
strBody = ""
Do While Not rstSingle.EOF
strLine1 = ""
strLine2 = ""
strGrade1 = ""
strGrade2 = ""
strSlipNo = Nz(rstSingle![SlipNo])
dteSold = Nz(rstSingle![DateSold])
dtePickup = Nz(rstSingle![ScheduledPickup])
strFCFNumber = Nz(rstSingle![FCFNumber])
strGrade1 = Nz(rstSingle![Grade1])
Debug.Print "Grade 1: " & strGrade1
strGrade2 = Nz(rstSingle![Grade2])
Debug.Print "Grade 2: " & strGrade2
strNotes = Nz(rstSingle![Notes])
'Create line of body text
strLine1 = "<font face='Arial', size=3" _
& " <tr>" _
& " <td width='283'valign='bottom' align='left'>" & strGrade1 & "</td>" _
& " <td width='127' valign='bottom' align='left'>" & strFCFNumber _
& " <td width='144'valign='bottom' align='left'>" _
& Format(dtePickup, "m/d/yyyy") & "</td>" _
& " <td width='237'valign='bottom' align='left'>" & strNotes & "</td>" _
& " </tr></font>"
Debug.Print "Line 1: " & strLine1
If strGrade2 <> "" Then
strLine2 = "<font face='Arial', size=3>" _
& " <tr>" _
& " <td width='283'valign='bottom' align='left'>" & strGrade2 & "</td>" _
& " <td width='127' valign='bottom' align='left'>" & strFJDNumber _
& " <td width='144'valign='bottom' align='left'>" _
& Format(dtePickup, "m/d/yyyy") & "</td>" _
& " <td width='237'valign='bottom' align='left'>" _
& strNotes & "</font></td>" _
& " </tr>"
End If
Debug.Print "Line 2: " & strLine2
strHTMLBody = strHTMLBody & strLine1 & strLine2
rstSingle.MoveNext
Loop
strHTMLBody = strHeader & strHTMLBody & strSignature
Debug.Print "Message HTML body: " & strHTMLBody
msg.HTMLBody = strHTMLBody
msg.Display
End If
rstAll.MoveNext
Loop
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in CreateEmails procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Instead, I like to save the reports as PDF files and attach them. This is much easier. Here is an example of that technique:
Public Sub SendInterventionEmails()
'Created by Helen Feddema 10-Jan-2010
'Last modified by Helen Feddema 10-Jan-2010
On Error GoTo ErrorHandler
Dim appOutlook As New Outlook.Application
Dim itm As Outlook.MailItem
Dim rstIntervention As DAO.Recordset
Dim lngCount As Long
Dim lngID As Long
Dim rpt As Access.Report
Dim strFileName As String
Dim strPrompt As String
Dim strQuery As String
Dim strRecordSource As String
Dim strReport As String
Dim strSQL As String
Dim strTitle As String
Dim strCurrentPath As String
Dim strFileNameAndPath As String
Dim strEmailSource As String
strEmailSource = "qryInterventionEmail"
strRecordSource = "qryMissingAssignments"
strQuery = "qryMissingAssignmentsSingleStudent"
Set dbs = CurrentDb
Set rstIntervention = dbs.OpenRecordset(strEmailSource)
strCurrentPath = Application.CurrentProject.Path & "\"
'Use path selected with SelectFolder procedure
'strCurrentPath = SelectFolder()
With rstIntervention
Do While Not .EOF
lngID = ![StID]
Debug.Print "Processing Student ID " & lngID
strFileName = "Intervention Report for " & ![StFirst] _
& " " & ![StLast] & ".pdf"
strFileNameAndPath = strCurrentPath & strFileName
'Create filtered query
strSQL = "SELECT * FROM " & strRecordSource & " WHERE " _
& "[StID] = " & Chr(39) & lngID & Chr(39) & ";"
Debug.Print "SQL for " & strQuery & ": " & strSQL
lngCount = CreateAndTestQuery(strQuery, strSQL)
Debug.Print "No. of items found: " & lngCount
If lngCount = 0 Then
GoTo NextStudent
End If
'Open report with filtered query record source
strReport = "rptMissingAssignmentsNew"
DoCmd.OpenReport ReportName:=strReport, _
View:=acViewPreview, _
windowmode:=acWindowNormal
Set rpt = Reports(strReport)
DoCmd.OutputTo objecttype:=acOutputReport, _
objectname:=strReport, _
outputformat:=acFormatPDF, _
outputfile:=strFileNameAndPath
'Create email
Set itm = appOutlook.CreateItem(olMailItem)
itm.Subject = "MISSING WORK"
itm.Body = "The attached file lists your missing assignments"
itm.To = ![Email]
itm.Attachments.Add Source:=strFileNameAndPath, _
Type:=olByValue
'For editing before sending
itm.Display
'For sending automatically
'itm.Send
DoCmd.Close objecttype:=acReport, _
objectname:=strReport, _
Save:=acSaveNo
NextStudent:
.MoveNext
Loop
End With
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in SendInterventionEmails procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Public Function CreateAndTestQuery(strTestQuery As String, _
strTestSQL As String) As Long
'Created by Helen Feddema 28-Jul-2002
'Last modified by Helen Feddema 10-Jan-2010
On Error Resume Next
'Delete old query
Set dbs = CurrentDb
dbs.QueryDefs.Delete strTestQuery
On Error GoTo ErrorHandler
'Create new query
Set qdf = dbs.CreateQueryDef(strTestQuery, strTestSQL)
'Test whether there are any records
Set rst = dbs.OpenRecordset(strTestQuery)
With rst
.MoveFirst
.MoveLast
CreateAndTestQuery = .RecordCount
End With
ErrorHandlerExit:
Exit Function
ErrorHandler:
If Err.Number = 3021 Then
CreateAndTestQuery = 0
Resume ErrorHandlerExit
Else
MsgBox "Error No: " & Err.Number _
& " in CreateAndTestQuery procedure; " _
& "Description: " & Err.Description
End If
End Function
ASKER
Hi Helen,
Thanks for the input.
Unfortunetely I cannot do this as an attachment. It has to be in the email body.
I recieved some information from a friend as he creates an outlook template and uses vba from access to populate the merge fields. I however am not sure not sure how to get the merge fields to populate. I created the template. Now my brain is failing me.
If you have some input that would be awesome otherwise once I figure this out I will post my end result.
Kelly
Thanks for the input.
Unfortunetely I cannot do this as an attachment. It has to be in the email body.
I recieved some information from a friend as he creates an outlook template and uses vba from access to populate the merge fields. I however am not sure not sure how to get the merge fields to populate. I created the template. Now my brain is failing me.
If you have some input that would be awesome otherwise once I figure this out I will post my end result.
Kelly
ASKER
Ok I am posting my code thus far and asking for some help if I can. I have changed this quite a bit after tons of research. I have created an outlook template.This works perfectly except I cannot get the reference fields in my outlook template to populate with my form data.
The code gets the template, adds the to email, cc email, and subject and then saves the template into the draft folder.
Any help here is appreciated.
Kelly
The code gets the template, adds the to email, cc email, and subject and then saves the template into the draft folder.
Any help here is appreciated.
Kelly
Private Sub Cmd_EmailPoss_Click()
Dim strTo As Variant
Dim TemplateLocation As String
Dim strCC As Variant
Dim strBCC As Variant
Dim strMessageBody As String
Dim AppOutLook As Outlook.Application
Dim OutLookTemp As Outlook.MailItem
On Error Resume Next
' check to see if outlook is open
Set AppOutLook = GetObject(, "Outlook.Application")
On Error GoTo error_handler
' if outlook is not open create a new instance
If AppOutLook Is Nothing Then
Set AppOutLook = CreateObject("Outlook.Application")
End If
MsgBox "The email is about to be created!"
' Create email
Set OutLookTemp = AppOutLook.CreateItemFromTemplate("C:\Temp\POSS Mail Merge.oft")
With OutLookTemp
.To = Me.EMAIL
.CC = "FIU.Mailbox@LPL.com"
' Set the Subject, Body, and Importance of the message.
.Subject = Me.FIRST_NAME + " " + Me.LAST_NAME
.HTMLBody = Replace(.HTMLBody, "<Account_Number>", Me.ACCOUNT_NUM)
.HTMLBody = Replace(.HTMLBody, "<Client_Name> ", Me.FIRST_NAME + " " + Me.LAST_NAME)
.HTMLBody = Replace(.HTMLBody, "<REPNAME>", Me.REPNAME)
.HTMLBody = Replace(.HTMLBody, "<Text>", Me.TEXT)
.Save
End With
SendEmailTemplate = True
error_handler:
SendEmailTemplate = False
End Sub
Kelley,
<< .HTMLBody = Replace(.HTMLBody, "<Account_Number>", Me.ACCOUNT_NUM)>>
What happens when this line gets executed?
If you put a stop there, does .HTMLBody contain a string with <Account_Number> in it? In other words can you do:
Debug.? Instr(.HTMLBody,"<Account_ Number>") and get something other then 0?
can you also do:
Debug.? Me.Account_NUM and get the correct value?
JimD.
<< .HTMLBody = Replace(.HTMLBody, "<Account_Number>", Me.ACCOUNT_NUM)>>
What happens when this line gets executed?
If you put a stop there, does .HTMLBody contain a string with <Account_Number> in it? In other words can you do:
Debug.? Instr(.HTMLBody,"<Account_
can you also do:
Debug.? Me.Account_NUM and get the correct value?
JimD.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I don't see any custom properties in your code -- if that is the case, you may not need to create an item from a template. But possibly the template has a different layout, even though it may not have custom properties.
<<Thanks for all the input. I however solved my own issue with lots of research.>>
Make sure you accept your own last comment as asnwer.
JimD.
Make sure you accept your own last comment as asnwer.
JimD.
ASKER
I am not sure what you are meaning by custom properties. Let me know so that I understand in case there is something missing.
It was very easy to create the email template which holds the email letter and all of the html formatting.
The one problem that I am trying to resolve now is the null values in my form. For instance if there is not an email address, client name, repname ect it does not create the email. Other than this issue the above is a very simple solution and works perfectly.
Once I resolve the null values issue for the replace template value with form value I will post my end result code so someone else can benefit from this.
Kelly
It was very easy to create the email template which holds the email letter and all of the html formatting.
The one problem that I am trying to resolve now is the null values in my form. For instance if there is not an email address, client name, repname ect it does not create the email. Other than this issue the above is a very simple solution and works perfectly.
Once I resolve the null values issue for the replace template value with form value I will post my end result code so someone else can benefit from this.
Kelly
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Here is the end result resolving the null values, This works perfectly.
First create an outlook template.
Hope everyone has a great day.
Kelly
First create an outlook template.
Private Sub Cmd_EmailPoss_Click()
Dim strTo As Variant
Dim TemplateLocation As String
Dim strCC As Variant
Dim strMessageBody As String
Dim AppOutLook As Outlook.Application
Dim OutLookTemp As Outlook.MailItem
On Error Resume Next
' check to see if outlook is open
Set AppOutLook = GetObject(, "Outlook.Application")
On Error GoTo error_handler
' if outlook is not open create a new instance
If AppOutLook Is Nothing Then
Set AppOutLook = CreateObject("Outlook.Application")
End If
MsgBox "The email is about to be created!"
' Create email
Set OutLookTemp = AppOutLook.CreateItemFromTemplate("C:\Temp\POSS Mail Merge.oft")
With OutLookTemp
.To = Nz(Me.EMAIL, "")
.CC = "FIU.Mailbox@LPL.com"
' Set the Subject, Body, and Importance of the message.
.Subject = Nz(Me.FIRST_NAME + " " + Me.LAST_NAME, Me.FIRST_NAME)
.HTMLBody = Replace(.HTMLBody, "Account_Number", Nz(Me.ACCOUNT_NUM, ""))
.HTMLBody = Replace(.HTMLBody, "Client_Name", Nz(Me.FIRST_NAME + " " + Me.LAST_NAME, Me.FIRST_NAME))
.HTMLBody = Replace(.HTMLBody, "REPNAME", Nz(Me.REPNAME, ""))
.HTMLBody = Replace(.HTMLBody, "Text", Nz(Me.TEXT, ""))
.Save
End With
SendEmailTemplate = True
error_handler:
SendEmailTemplate = False
End Sub
Hope everyone has a great day.
Kelly
Kelly,
Watch out for this:
Nz(Me.FIRST_NAME + " " + Me.LAST_NAME, Me.FIRST_NAME))
Your using the + operator on a string. While it will work, unlike the concatenation operator for strings, it will propogate nulls. In other words this:
Debug.? "Jim" & NULL
will give you "Jim", but this:
Debug.? "Jim" + NULL
will result in null. Might not make a difference here with first/last name, but it's something you should be aware of.
JimD.
Watch out for this:
Nz(Me.FIRST_NAME + " " + Me.LAST_NAME, Me.FIRST_NAME))
Your using the + operator on a string. While it will work, unlike the concatenation operator for strings, it will propogate nulls. In other words this:
Debug.? "Jim" & NULL
will give you "Jim", but this:
Debug.? "Jim" + NULL
will result in null. Might not make a difference here with first/last name, but it's something you should be aware of.
JimD.
ASKER
Thanks Jim This works perfectly for the Nulls.
Hope your day is great.
Hope your day is great.
Your going to have verying degrees of sucess in saving a report to an HTML file. If you need exact output, you need to use PDF or the Access snapshot format.
JimD.