Format text in a vba generated e-mail

Sandra Smith
Sandra Smith used Ask the Experts™
on
I have a email that uses a query for the body.  However, the user of this email wants the first column (job_code) to be in blue bold and the second column (Ratio) in red bold - but how do I do that?
strbody = "Hi " & strAnalyst & " " & vbCrLf & vbCrLf & _
          "The following job(s) need your attention. "
With rst
    strMailBody = "Incomplete: " & vbCrLf & _
                  "This includes all jobs that are not 100%.  If a recipient has received the report outside of CRS, " & _
                  "please update the recipient status to success." & vbCrLf & vbCrLf
  Do While Not .EOF
    strMailBody = strMailBody & ![job_code] & vbTab & " Ratio: " & Format(![Ratio], "0.00%") & vbCrLf
      .MoveNext
  Loop
End With
rst.Close
Set rst = Nothing

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®

Commented:
What are you using for sending the email? If you are using Outlook you can format it using html something like this:

Dim objOutlook As Object
Dim objOutlookMsg As Object
 
        ' Create the Outlook session.
        Set objOutlook = CreateObject("Outlook.Application")
 
        ' Create the message.
        Set objOutlookMsg = objOutlook.CreateItem(0)
   
 
        With objOutlookMsg
            .To = EmailAddress
            .HTMLBody = "<body><Font Color=Blue> Hello </Font> <Font Color=Red> Hello </Font></Body>"
            .Save
            .Display
 
        End With

 
        Set objOutlookMsg = Nothing
        Set objOutlook = Nothing

Sandra SmithRetired

Author

Commented:
Yes, am using Outlook..  There are three results sets, each with two data fields which the user wants differetn colors.  So, if I understand, I can do the following:

strMailBody = strMailBody & <Font Color=Blue> ![job_code]<.Font> & vbTab & " Ratio: " & <Font Color=Red>Format(![Ratio], "0.00%") </Font> & vbCrLf
Sandra SmithRetired

Author

Commented:
No, that does not work
Should you be charging more for IT Services?

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Sandra SmithRetired

Author

Commented:
I am attaching the entire code so you can see what I am up against.  Again, the user wants each column in the result different colors, right now, I am only focusing on getting the "Incomplete" section formatted correctly.
Private Sub cmdEmail_Click()
On Error GoTo ErrorHandler
Dim objOutApp As Object
Dim objOutMail As Object
Dim strbody As String
Dim strbodyAll As String
Dim strEmailIncomplete As String
Dim strEmailException As String
Dim strEmailBadName As String
Dim qdfEmailIncomplete As QueryDef
Dim qdfEmailException As QueryDef
Dim qdfEmailBadName As QueryDef
Dim strUserID As String
Dim strEmailAddress As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strMailBody As String
Dim strAnalyst As String
Dim strTest As String

strUserID = Me.cboAssociate.Column(0)
strAnalyst = Me.cboAssociate.Column(3)

If Me.cboJobDay = "<All>" Then
strEmailIncomplete = "SELECT tblStatusResults.job_code, tblStatusResults.Ratio " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'Incomplete' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' "
Else
strEmailIncomplete = "SELECT tblStatusResults.job_code, tblStatusResults.Ratio " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'Incomplete' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' AND " & _
    "tblStatusResults.BDDay = '" & Me.cboJobDay & "' "
End If

If Me.cboJobDay = "<All>" Then
strEmailException = "SELECT tblStatusResults.job_id, tblStatusResults.job_code " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'Exception' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' "
Else
strEmailException = "SELECT tblStatusResults.job_id, tblStatusResults.job_code " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'Exception' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' AND " & _
    "tblStatusResults.BDDay = '" & Me.cboJobDay & "' "
End If

If Me.cboJobDay = "<All>" Then
strEmailBadName = "SELECT tblStatusResults.job_id, tblStatusResults.job_code " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'BadName' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' "
Else
strEmailBadName = "SELECT tblStatusResults.job_id, tblStatusResults.job_code " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'BadName' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' AND " & _
    "tblStatusResults.BDDay = '" & Me.cboJobDay & "' "
End If

strEmailAddress = Me.cboAssociate.Column(2)

If DoesObjectExist("qryEmailIncomplete", "Query") Then DoCmd.DeleteObject acQuery, "qryEmailIncomplete"
If DoesObjectExist("qryEmailException", "Query") Then DoCmd.DeleteObject acQuery, "qryEmailException"
If DoesObjectExist("qryEmailBadName", "Query") Then DoCmd.DeleteObject acQuery, "qryEmailBadName"

If strUserID = "<All>" Then
    MsgBox "You must select a person in order to send an email", vbOKOnly
    Exit Sub
End If

Set db = CurrentDb
Set qdfEmailIncomplete = db.CreateQueryDef("qryEmailIncomplete", strEmailIncomplete)
DoCmd.OpenQuery "qryEmailIncomplete"
DoCmd.Close acQuery, "qryEmailIncomplete"
Set rst = db.OpenRecordset("qryEmailIncomplete", dbOpenForwardOnly)

Set objOutApp = CreateObject("Outlook.Application")
Set objOutMail = objOutApp.CreateItem(0)

strbody = "Hi " & strAnalyst & " " & vbCrLf & vbCrLf & _
          "The following job(s) need your attention. "
With rst
    strMailBody = "Incomplete: " & vbCrLf & _
                  "This includes all jobs that are not 100%.  If a recipient has received the report outside of CRS, " & _
                  "please update the recipient status to success." & vbCrLf & vbCrLf
  Do While Not .EOF
    strMailBody = strMailBody & ![job_code] & vbTab & " Ratio: " & Format(![Ratio], "0.00%") & vbCrLf
      .MoveNext
  Loop
End With
rst.Close
Set rst = Nothing

Set qdfEmailIncomplete = db.CreateQueryDef("qryEmailException", strEmailException)
DoCmd.OpenQuery "qryEmailException"
DoCmd.Close acQuery, "qryEmailException"
Set rst = db.OpenRecordset("qryEmailException", dbOpenForwardOnly)
 
With rst
    strMailBody = strMailBody & vbCrLf & vbCrLf & "Exceptions: " & vbCrLf & vbCrLf
  Do While Not .EOF
    strMailBody = strMailBody & ![job_code] & vbCrLf
      .MoveNext
  Loop
End With
rst.Close
Set rst = Nothing

Set qdfEmailIncomplete = db.CreateQueryDef("qryEmailBadName", strEmailBadName)
DoCmd.OpenQuery "qryEmailbadName"
DoCmd.Close acQuery, "qryEmailBadName"
Set rst = db.OpenRecordset("qryEmailBadName", dbOpenForwardOnly)
 
With rst
    strMailBody = strMailBody & vbCrLf & vbCrLf & "Bad Naming Convention: " & vbCrLf & vbCrLf
  Do While Not .EOF
    strMailBody = strMailBody & ![job_code] & vbCrLf
      .MoveNext
  Loop
End With
  
strbodyAll = strbody & vbCrLf & vbCrLf & strMailBody

rst.Close
Set rst = Nothing
Set db = Nothing

    With objOutMail
        .To = strEmailAddress
        .CC = ""
        .BCC = ""
        .Subject = "Attention:  Job Status " & Format(Date, "mm/dd/yyyy")
        .Body = strbodyAll
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        '.Send
        .Display
    End With
    On Error GoTo 0

    Set objOutMail = Nothing
    Set objOutApp = Nothing

'DoCmd.DeleteObject acQuery, "qryEmailIncomplete"
'DoCmd.DeleteObject acQuery, "qryEmailException"
'DoCmd.DeleteObject acQuery, "qryEmailBadName"


Exit_ErrorHandler:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " Description: " & Err.Description
        Resume Exit_ErrorHandler

End Sub

Open in new window

Commented:
Yes.. that was pretty much right except that you want quotes around the <font> codes.. like this:

strMailBody = strMailBody & "<Font Color=Blue>" & ![job_code] & "</Font>" & vbTab & "Ratio: <Font Color=Red>" & Format(![Ratio], "0.00%") & "</Font>" & vbCrLf

So.. you will want to add the font codes as string values on either side of the items you would like colored.. and you have to use .HTMLBody instead of .Body

.HTMLBody = strbodyAll

and that should work.. Does that work for you or are you still having any issues?
Sandra SmithRetired

Author

Commented:
Let me try that and will be right back.
Sandra SmithRetired

Author

Commented:
WOW!  I got colors,but it killed all my other formatting.  The original results were in three sections on the e-mail.  Now it is one long paragraph of data but with colors!  So, I have colors but now need to get formatting back.  but the is another question.  Thank you.
Sandra SmithRetired

Author

Commented:
Got my colors.
Sandra SmithRetired

Author

Commented:
Option Compare Database
Option Explicit
Private Sub RefreshData()
Dim strSelect As String
Dim strWhere As String
Dim strAssociate As String
Dim strBDDay As String
Dim strProblemGroup As String

strAssociate = Me.cboAssociate.Column(0)
strBDDay = Me.cboJobDay.Column(0)
strProblemGroup = Me.cboProblemGroup

strSelect = "SELECT tblStatusResults.SortOrder, tblStatusResults.EstPeriod, tblStatusResults.job_id, " & _
    "tblStatusResults.BDDay, t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name AS UserName, " & _
    "tblStatusResults.job_code, tblStatusResults.job_nm, tblStatusResults.Ratio, tblStatusResults.FromDate, " & _
    "tblStatusResults.AsOFDate, tblStatusResults.ExpectedDate, tblStatusResults.Exception, tblStatusResults.GoodBad, " & _
    "tblStatusResults.ProblemGroup, " & _
    "IIf(tblStatusResults.Exception=-1,IIf(IsNull(tblStatusResults.AsOfDate),'Never Run','ExpectedDate: ' & tblStatusResults.ExpectedDate),'') AS ExceptionComment " & _
    "FROM tblStatusResults LEFT JOIN t_lu_user ON tblStatusResults.first_associate_id = t_lu_user.user_ldap_login "

If strAssociate = "<All>" And strBDDay = "<All>" And strProblemGroup = "<All>" Then
        strWhere = "ORDER BY tblStatusResults.ProblemGroup DESC, tblStatusResults.SortOrder, " & _
                    "t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name, " & _
                   "tblStatusResults.job_code, tblStatusResults.Ratio DESC "
        Me.RecordSource = strSelect & strWhere
        Me.Requery
        Me.Refresh
ElseIf strAssociate <> "<All>" And strBDDay <> "<All>" And strProblemGroup <> "<All>" Then
        strWhere = "WHERE tblStatusResults.first_associate_id = '" & strAssociate & "' AND " & _
                   "tblStatusResults.BDDay = '" & strBDDay & "' and tblStatusResults.ProblemGroup = '" & strProblemGroup & "' " & _
                   "ORDER BY tblStatusResults.ProblemGroup DESC, tblStatusResults.SortOrder, " & _
                   "t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name, " & _
                   "tblStatusResults.job_code, tblStatusResults.Ratio DESC "
        Me.RecordSource = strSelect & strWhere
        Me.Requery
        Me.Refresh
       
ElseIf strAssociate = "<All>" And strBDDay <> "<All>" And strProblemGroup = "<All>" Then
        strWhere = "WHERE tblStatusResults.BDDay = '" & strBDDay & "' " & _
                   "ORDER BY tblStatusResults.ProblemGroup DESC, tblStatusResults.SortOrder, " & _
                    "t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name, " & _
                   "tblStatusResults.job_code, tblStatusResults.Ratio DESC "
        Me.RecordSource = strSelect & strWhere
        Me.Requery
        Me.Refresh
ElseIf strAssociate = "<All>" And strBDDay <> "<All>" And strProblemGroup <> "<All>" Then
        strWhere = "WHERE tblStatusResults.BDDay = '" & strBDDay & "' " & _
                   "and tblStatusResults.ProblemGroup = '" & strProblemGroup & "' " & _
                   "ORDER BY tblStatusResults.ProblemGroup DESC, tblStatusResults.SortOrder, " & _
                    "t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name, " & _
                   "tblStatusResults.job_code, tblStatusResults.Ratio DESC "
        Me.RecordSource = strSelect & strWhere
        Me.Requery
        Me.Refresh
ElseIf strAssociate <> "<All>" And strBDDay = "<All>" And strProblemGroup = "<All>" Then
        strWhere = "WHERE tblStatusResults.first_associate_id = '" & strAssociate & "' " & _
                   "ORDER BY tblStatusResults.ProblemGroup DESC, tblStatusResults.SortOrder, " & _
                   "t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name, " & _
                   "tblStatusResults.job_code, tblStatusResults.Ratio DESC "
        Me.RecordSource = strSelect & strWhere
        Me.Requery
        Me.Refresh
ElseIf strAssociate <> "<All>" And strBDDay = "<All>" And strProblemGroup <> "<All>" Then
    strWhere = "WHERE tblStatusResults.first_associate_id = '" & strAssociate & "' " & _
               "ORDER BY tblStatusResults.ProblemGroup DESC, tblStatusResults.SortOrder, " & _
               "t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name, " & _
               "tblStatusResults.job_code, tblStatusResults.Ratio DESC "
    Me.RecordSource = strSelect & strWhere
    Me.Requery
    Me.Refresh
ElseIf strAssociate = "<All>" And strBDDay = "<All>" And strProblemGroup <> "<All>" Then
        strWhere = "WHERE tblStatusResults.ProblemGroup = '" & strProblemGroup & "' " & _
                   "ORDER BY tblStatusResults.ProblemGroup DESC, tblStatusResults.SortOrder, " & _
                   "t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name, " & _
                   "tblStatusResults.job_code, tblStatusResults.Ratio DESC "
        Me.RecordSource = strSelect & strWhere
        Me.Requery
        Me.Refresh
ElseIf strAssociate <> "<All>" And strBDDay <> "<All>" And strProblemGroup = "<All>" Then
    strWhere = "WHERE tblStatusResults.first_associate_id = '" & strAssociate & "' " & _
                "AND tblStatusResults.ProblemGroup = '" & strProblemGroup & "' " & _
               "ORDER BY tblStatusResults.ProblemGroup DESC, tblStatusResults.SortOrder, " & _
               "t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name, " & _
               "tblStatusResults.job_code, tblStatusResults.Ratio DESC "
    Me.RecordSource = strSelect & strWhere
    Me.Requery
    Me.Refresh
End If

End Sub
Private Sub cboAssociate_AfterUpdate()
    Call RefreshData
End Sub

Private Sub cboProblemGroup_AfterUpdate()
Dim strSelect As String
Dim strProblemGroup As String
Dim strWhere As String
strProblemGroup = Me.cboProblemGroup

strSelect = "SELECT tblStatusResults.SortOrder, tblStatusResults.EstPeriod, tblStatusResults.job_id, " & _
    "tblStatusResults.BDDay, t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name AS UserName, " & _
    "tblStatusResults.job_code, tblStatusResults.job_nm, tblStatusResults.Ratio, tblStatusResults.FromDate, " & _
    "tblStatusResults.AsOFDate, tblStatusResults.ExpectedDate, tblStatusResults.Exception, tblStatusResults.GoodBad, " & _
    "tblStatusResults.ProblemGroup, " & _
    "IIf(tblStatusResults.Exception=-1,IIf(IsNull(tblStatusResults.AsOfDate),'Never Run','ExpectedDate: ' & tblStatusResults.ExpectedDate),'') AS ExceptionComment " & _
    "FROM tblStatusResults LEFT JOIN t_lu_user ON tblStatusResults.first_associate_id = t_lu_user.user_ldap_login "

If strProblemGroup = "<All>" Then
    strWhere = "ORDER BY tblStatusResults.ProblemGroup DESC, tblStatusResults.SortOrder, " & _
                "t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name, " & _
               "tblStatusResults.job_code, tblStatusResults.Ratio DESC "
    Me.RecordSource = strSelect & strWhere
    Me.Requery
    Me.Refresh
Else
    strWhere = "WHERE tblStatusResults.ProblemGroup = '" & strProblemGroup & "' " & _
               "ORDER BY tblStatusResults.ProblemGroup DESC, tblStatusResults.SortOrder, " & _
                "t_lu_user.user_last_name & ', ' & t_lu_user.user_first_name, " & _
               "tblStatusResults.job_code, tblStatusResults.Ratio DESC "
    Me.RecordSource = strSelect & strWhere
    Me.Requery
    Me.Refresh
End If

End Sub

Private Sub cboJobDay_AfterUpdate()
    Call RefreshData
End Sub

Private Sub cmdClose_Click()
On Error GoTo Err_cmdClose_Click
    DoCmd.OpenForm "frmCriteria", acNormal
    DoCmd.Close acForm, Me.Name
Exit_cmdClose_Click:
    Exit Sub
Err_cmdClose_Click:
    MsgBox Err.Description
    Resume Exit_cmdClose_Click
End Sub

Private Sub cmdEmail_Click()
On Error GoTo ErrorHandler
Dim objOutApp As Object
Dim objOutMail As Object
Dim strbody As String
Dim strbodyAll As String
Dim strEmailIncomplete As String
Dim strEmailException As String
Dim strEmailBadName As String
Dim qdfEmailIncomplete As QueryDef
Dim qdfEmailException As QueryDef
Dim qdfEmailBadName As QueryDef
Dim strUserID As String
Dim strEmailAddress As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strMailBody As String
Dim strAnalyst As String
Dim strTest As String

strUserID = Me.cboAssociate.Column(0)
strAnalyst = Me.cboAssociate.Column(3)

If Me.cboJobDay = "<All>" Then
strEmailIncomplete = "SELECT tblStatusResults.job_code, tblStatusResults.Ratio " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'Incomplete' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' "
Else
strEmailIncomplete = "SELECT tblStatusResults.job_code, tblStatusResults.Ratio " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'Incomplete' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' AND " & _
    "tblStatusResults.BDDay = '" & Me.cboJobDay & "' "
End If

If Me.cboJobDay = "<All>" Then
strEmailException = "SELECT  tblStatusResults.job_code, " & _
    "IIf(tblStatusResults.Exception=-1,IIf(IsNull(tblStatusResults.AsOfDate),'Never Run','ExpectedDate: ' & tblStatusResults.ExpectedDate),'') " & _
    "As ExpectedComments " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'Exception' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' "
Else
strEmailException = "SELECT tblStatusResults.job_code, " & _
    "IIf(tblStatusResults.Exception=-1,IIf(IsNull(tblStatusResults.AsOfDate),'Never Run','ExpectedDate: ' & tblStatusResults.ExpectedDate),'') " & _
    "As ExpectedComments " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'Exception' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' AND " & _
    "tblStatusResults.BDDay = '" & Me.cboJobDay & "' "
End If


If Me.cboJobDay = "<All>" Then
strEmailBadName = "SELECT tblStatusResults.job_id, tblStatusResults.job_code " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'BadName' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' "
Else
strEmailBadName = "SELECT tblStatusResults.job_id, tblStatusResults.job_code " & _
    "FROM tblStatusResults " & _
    "WHERE tblStatusResults.ProblemGroup = 'BadName' AND " & _
    "tblStatusResults.first_associate_id = '" & strUserID & "' AND " & _
    "tblStatusResults.BDDay = '" & Me.cboJobDay & "' "
End If

strEmailAddress = Me.cboAssociate.Column(2)

If DoesObjectExist("qryEmailIncomplete", "Query") Then DoCmd.DeleteObject acQuery, "qryEmailIncomplete"
If DoesObjectExist("qryEmailException", "Query") Then DoCmd.DeleteObject acQuery, "qryEmailException"
If DoesObjectExist("qryEmailBadName", "Query") Then DoCmd.DeleteObject acQuery, "qryEmailBadName"

If strUserID = "<All>" Then
    MsgBox "You must select a person in order to send an email", vbOKOnly
    Exit Sub
End If

Set db = CurrentDb
Set qdfEmailIncomplete = db.CreateQueryDef("qryEmailIncomplete", strEmailIncomplete)
DoCmd.OpenQuery "qryEmailIncomplete"
DoCmd.Close acQuery, "qryEmailIncomplete"
Set rst = db.OpenRecordset("qryEmailIncomplete", dbOpenForwardOnly)

Set objOutApp = CreateObject("Outlook.Application")
Set objOutMail = objOutApp.CreateItem(0)

strbody = "Hi " & strAnalyst & " " & vbCrLf & vbCrLf & _
          "The following job(s) need your attention. "
With rst
    strMailBody = "Incomplete: " & vbCrLf & _
                  "This includes all jobs that are not 100%.  If a recipient has received the report outside of CRS, " & _
                  "please update the recipient status to success." & vbCrLf & vbCrLf
  Do While Not .EOF
    strMailBody = strMailBody & "<Font Color=Blue>" & ![job_code] & "</Font>" & vbTab & "Ratio: <Font Color=Red>" & Format(![Ratio], "0.00%") & "</Font>" & vbCrLf
      .MoveNext
  Loop
End With
rst.Close
Set rst = Nothing

Set qdfEmailIncomplete = db.CreateQueryDef("qryEmailException", strEmailException)
DoCmd.OpenQuery "qryEmailException"
DoCmd.Close acQuery, "qryEmailException"
Set rst = db.OpenRecordset("qryEmailException", dbOpenForwardOnly)
 
With rst
    strMailBody = strMailBody & vbCrLf & vbCrLf & "Exceptions: " & vbCrLf & vbCrLf
  Do While Not .EOF
    strMailBody = strMailBody & ![job_code] & vbTab & vbTab & "Expected Date range is: " & ![ExpectedComments] & vbCrLf
      .MoveNext
  Loop
End With
rst.Close
Set rst = Nothing

Set qdfEmailIncomplete = db.CreateQueryDef("qryEmailBadName", strEmailBadName)
DoCmd.OpenQuery "qryEmailbadName"
DoCmd.Close acQuery, "qryEmailBadName"
Set rst = db.OpenRecordset("qryEmailBadName", dbOpenForwardOnly)
 
With rst
    strMailBody = strMailBody & vbCrLf & vbCrLf & "Bad Naming Convention: " & vbCrLf & vbCrLf
  Do While Not .EOF
    strMailBody = strMailBody & ![job_code] & vbCrLf
      .MoveNext
  Loop
End With
 
strbodyAll = strbody & vbCrLf & vbCrLf & strMailBody

rst.Close
Set rst = Nothing
Set db = Nothing

    With objOutMail
        .To = strEmailAddress
        .Subject = "Attention:  Job Status " & Format(Date, "mm/dd/yyyy")
        .HTMLBody = strbodyAll
        .Display
    End With
    On Error GoTo 0

    Set objOutMail = Nothing
    Set objOutApp = Nothing

'DoCmd.DeleteObject acQuery, "qryEmailIncomplete"
'DoCmd.DeleteObject acQuery, "qryEmailException"
'DoCmd.DeleteObject acQuery, "qryEmailBadName"


Exit_ErrorHandler:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " Description: " & Err.Description
        Resume Exit_ErrorHandler

End Sub

Private Sub Form_Open(Cancel As Integer)
    Me.cboAssociate = "<All>"
    Me.cboJobDay = "<All>"
    Me.cboProblemGroup = "<All>"
End Sub

This is what I have now, with only the one line changed.

Open in new window

Sandra SmithRetired

Author

Commented:
Sorry, copied the entire modlue and can't figure out how to delete it.

Commented:
I'm sorry.. You know.. If you have items aligned like a table..  I think what you might to want to do then is use a table to format your email. Do you know very much HTML? It might take a little work to get it formatted exactly how you want it.. You can also use <br> in place of vbcrlf or &nbsp; to indicate a space.

Table would be something like this:

  "<table border=0 width=172 height=48>" & _
    "<tr>" & _
      "<td width=74 height=21><Font Color=Blue>" & DATA & "</td>" & _
      "<td width=82 height=21><Font Color=Red>" & DATA & "</td>" & _
    "</tr>" & _
    "<tr>" & _
      "<td width=74 height=21><Font Color=Blue>" & DATA & "</td>" & _
      "<td width=82 height=21><Font Color=Red>" & DATA & "</td>" & _
   " </tr>" & _
  "</table>"
Sandra SmithRetired

Author

Commented:
Thank you, am also posting another question as now the user wants the font to be Ariel.  Have not worked with HTML at all so this is new territory for me.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial