Just a quick question for someone more knowledgable than I with Access.
I have code working that runs from a form, building a query based on the form fields input. This query is then used to generate an email distribution list and an email is then created to send to the recipients.
This works fine, however, I cannot get the email to go in HTML. Whatever is entered into the form, is always send on one line without any line breaks. So is not really usefull.
Can anyone tell me how to set up the email to send as HTML and as is seen when it is written into the form input field ?
Snippet of code is included as reference
Sendoutlookemail is the procedure to send the email
errorHandling is an error handling procedure
thanks in advance
Private Sub Send_Mail_Click()
On Error GoTo Err_SendEmail
Dim sTo As String
Dim sCC As String
Dim sBCC As String
Dim sSubject As String
Dim sBody As String
Dim sAttachmentList As String
Dim sReplyRecipient As String
Dim oFSO As New FileSystemObject
Dim db As DAO.Database
Dim qryMail As QueryDef
Dim MailList As DAO.Recordset
' this is a test to make sure the type of customer is chosen otherwise exit
If Me.Choice = "" Then ' from form
MsgBox " You have to select a customer status "
' You must key a semicolon between each email name
sTo = ""
sCC = ""
sBCC = ""
sReplyRecipient = "email@example.com"
sSubject = Me.Mess_Subject ' from form
sBody = Me.mess_text ' from form
'Path to the text file
If Left(Me.Mail_Attachment_Path, 1) <> "<" Then
Attachment = Me.Mail_Attachment_Path
Attachment = 1
Attachment = 0
' does attachment exist
If Dir(Attachment) = "" Then
MsgBox "Document not found. Please check path"
Attachment = 0
' Set up the database and query connections
Set db = CurrentDb 'chosen database
' define query to be used from database
Set qryMail = db.QueryDefs("MyEmailAddresses")
Set MailList = qryMail.OpenRecordset '
' now, this is where we go through our list of addresses,
' adding them to the sCC list
' LOOP through all the emails on the list
Do While Not MailList.EOF
If MailList![Status] = Me.Choice Then
NewEmail = MailList![EmailAddress]
sBCC = sBCC & ";" & NewEmail
'send email but first check if there is an attachment
If Attachment = 0 Then ' send without a file attachment
Call SetupOutlookEmail(sTo, sCC, sBCC, sReplyRecipient, sSubject, sBody)
Else ' send with a file attachment
Call SetupOutlookEmail(sTo, sCC, sBCC, sReplyRecipient, sSubject, sBody, sAttachmentList)
If Err.Number = -2147024894 Then 'Cannot find this file. Verify the path and file name are correct.
MsgBox "Email message was not sent. Please verify the file " & sPathFile & " exists before attempting to resend the email.", vbCritical, "Invalid File Attachment"
ElseIf Err.Number = -2147467259 Then 'Outlook does not recognize one or more names.
MsgBox "Email message was not sent. Please verify all user names and email addresses are valid before attempting to resend the email.", vbCritical, "Invalid Email Name"
Call ErrorHandling(Err.Number, Err.Description, "sendmail_Click", "2-Email_clients_Monthly")
Public Function SetupOutlookEmail(ByVal sTo As String, ByVal sCC As String, ByVal sBCC As String, ByVal sReplyRecipient As String, ByVal sSubject As String, ByVal sBody As String, ParamArray sAttachmentList() As Variant) As Boolean
On Error GoTo Err_SetupOutlookEmail
Dim objOLApp As Object
Dim outItem As Object
Dim outFolder As Object
Dim DestFolder As Object
Dim outNameSpace As Object
Dim lngAttachment As Long
Set objOLApp = CreateObject("Outlook.Application")
Set outNameSpace = objOLApp.GetNamespace("MAPI")
Set outFolder = outNameSpace.GetDefaultFolder(6)
Set outItem = objOLApp.CreateItem(0)
outItem.To = sTo
outItem.CC = sCC
outItem.BCC = sBCC
outItem.Subject = sSubject
outItem.Body = sBody
outItem.ReadReceiptRequested = False
For lngAttachment = LBound(sAttachmentList) To UBound(sAttachmentList)
'setup and open email in edit mode instead of sending the email
SetupOutlookEmail = True
On Error Resume Next
Set outItem = Nothing
Set outFolder = Nothing
Set outNameSpace = Nothing
Set objOLApp = Nothing
If Err.Number = 287 Then 'User stopped Outlook from sending email.
MsgBox "User aborted email.", vbInformation, "Email Cancelled"
Call ErrorHandling(Err.Number, Err.Description, "SetupOutlookEmail module", "Function in Main_window_Open_Module")