Manipulating String colors in VBA

MS Access application generate emails.   Applications builds the email message body programmatically.  

dim messagebody, starttext, endtext as string
dim startdate as string

startdate =  'value assigned based by program logic'

Messagebody =  starttext & startdate & endtext

The requirement is to manipulate the font characteristics of the startdate field.  For example that field should appear in an alternate color and in bold.

Please advise
rafavroAsked:
Who is Participating?
 
[ fanpages ]Connect With a Mentor IT Services ConsultantCommented:
Are you creating e-mails using the HTMLBody property of the Outlook.Application.MailItem object?

Here's some sample code that demonstrates how to make the "StartDate" variable colo[u]red Red & in Bold...

' Start of Code...

Option Explicit

Public Const olImportanceHigh                           As Long = 2&
Public Const olImportanceLow                            As Long = 0&
Public Const olImportanceNormal                         As Long = 1&

Public Enum intSave_Display_Send
  intSave = 1
  intDisplay = 2
  intSend = 4
End Enum
Public Sub Send_Email(Optional ByVal strTo As String = "experts_fp" & "@" & "yahoo.co.uk;", _
                      Optional ByVal strCc As String = "", _
                      Optional ByVal strBcc As String = "", _
                      Optional ByVal strSubject As String = "Subject", _
                      Optional ByVal strBody As String = "Body", _
                      Optional ByVal blnHTMLBody As Boolean = True, _
                      Optional ByVal lngImportance As Long = olImportanceNormal, _
                      Optional ByVal blnReturn_Receipt As Boolean = True, _
                      Optional ByVal intProcess As intSave_Display_Send = intDisplay)
 
' ----------------------------------------------------------------------------------------------
' Experts Exchange Question:
' http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_21894721.html
' Manipulating String colors in VBA
'
' Copyright (c) 2006 Clearlogic Concepts (UK) Limited
' N.Lee [ http://NigelLee.info ] - 22 June 2006
' ----------------------------------------------------------------------------------------------

  Dim lngErr_Number                                     As Long
  Dim objOutlook_Application                            As Object
  Dim objOutlook_MailItem                               As Object
 
  On Error Resume Next
 
  Const olMailItem                                      As Long = 0&

  Set objOutlook_Application = Nothing
  Set objOutlook_MailItem = Nothing
 
  Set objOutlook_Application = GetObject(, "Outlook.Application")
 
  lngErr_Number = Err.Number
 
  On Error GoTo Err_Send_Email
 
  If lngErr_Number <> 0& Then
     Set objOutlook_Application = CreateObject("Outlook.Application")
  End If
 
  If Not (objOutlook_Application Is Nothing) Then
     Set objOutlook_MailItem = objOutlook_Application.CreateItem(olMailItem)
  End If
           
  If Not (objOutlook_MailItem Is Nothing) Then
     objOutlook_MailItem.To = strTo
     objOutlook_MailItem.CC = strCc
     objOutlook_MailItem.BCC = strBcc
     objOutlook_MailItem.Subject = strSubject
     
     If (blnHTMLBody) Then
        objOutlook_MailItem.HTMLBody = strBody
     Else
        objOutlook_MailItem.Body = strBody
     End If
     
     objOutlook_MailItem.Importance = lngImportance
     objOutlook_MailItem.ReadReceiptRequested = blnReturn_Receipt
     
' Add Attachments here...

'     objOutlook_MailItem.Attachments.Add "c:\file1.txt"
'     objOutlook_MailItem.Attachments.Add "c:\file2.jpg2"
     
' etc.
     
     Select Case (intProcess)
     
         Case (intSave)
             objOutlook_MailItem.Save
             
         Case (intDisplay)
             objOutlook_MailItem.Save
             objOutlook_MailItem.Display
             
         Case (intSend)
             objOutlook_MailItem.Send
             
         Case Else
         
     End Select
  End If

Exit_Send_Email:

  On Error Resume Next
 
  Set objOutlook_MailItem = Nothing
  Set objOutlook_Application = Nothing
 
  Exit Sub
 
Err_Send_Email:

  MsgBox "Error #" & CStr(Err.Number) & vbCr & vbCrLf & Err.Description, _
         vbExclamation Or vbOKOnly, _
         "Test E-mail"
         
  Resume Exit_Send_Email
 
End Sub
Public Sub Test()

  Dim EndText                                           As String
  Dim MessageBody                                       As String
  Dim StartDate                                         As String
  Dim StartText                                         As String
 
  StartText = "(Start Text) "
  StartDate = Format$(Now(), "Long Date")
  EndText = " (End Text)"
 
  MessageBody = StartText & "<font color=red><bold>" & StartDate & "</bold></font>" & EndText
 
  Call Send_Email("experts_fp" & Chr$(64) & "yahoo.co.uk", _
                  "", _
                  "", _
                  "Q_21894721", _
                  MessageBody, _
                  True, _
                  olImportanceNormal, _
                  True, _
                  intDisplay)
 
End Sub

' ...End of Code


BFN,

fp.
0
 
[ fanpages ]IT Services ConsultantCommented:
Sorry... got the VBA correct, but not the HTML! :)

Please replace this line:

MessageBody = StartText & "<font color=red><bold>" & StartDate & "</bold></font>" & EndText

With:

MessageBody = StartText & "<font color=red><b>" & StartDate & "</b></font>" & EndText


Thanks.

BFN,

fp.
0
 
[ fanpages ]IT Services ConsultantCommented:
Hi Dan,

I believe my code addresses the question, and hence should be considered as an acceptable answer.

Thank you.

BFN,

fp.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.