Search code examples
vbaemailoutlookoutlook-2010

Programmatically change properties in email body in Outlook with VBA


I have an email ready to be sent in Outlook 2013 I want to scan the body of the email for bold text (i.e., bold characters) and change its color to red (nice to have) Exclude from the macro the signature

I put together the code below but still not working. Any ideas?

Public Sub FormatSelectedText()
    Dim objItem As Object
    Dim objInsp As Outlook.Inspector

    ' Add reference to Word library
    ' in VBA Editor, Tools, References
    Dim objWord As Word.Application
    Dim objDoc As Word.Document
    Dim objSel As Word.Selection
    On Error Resume Next

    'Reference the current Outlook item
    Set objItem = Application.ActiveInspector.CurrentItem
    If Not objItem Is Nothing Then
        If objItem.Class = olMail Then
            Set objInsp = objItem.GetInspector
            If objInsp.EditorType = olEditorWord Then

                Set objDoc = objInsp.WordEditor
                Set objWord = objDoc.Application
                Set objSel = objWord.Selection
                Set objChar = Characters.Selection

                ' replace the With block with your code
                   With objChar
                   ' Formatting code goes here
                        '.Font.Size = 18
                        If .Font.Bold = True Then
                            .Font.Color = wdColorBlue
                        End If
                        .Font.Color = wdColorRed
                        '.Font.Italic = True
                        '.Font.Name = "Arial"
                   End With

                 For Each Char In Characters.Selection
                     If Char.Font.Bold Then
                        Char.Font.Color = RGB(0, 0, 255) 'TextRGBTmp
                     End If
                 Next Char

                 For Each Char In Characters.Selection
                     If Not Char.Font.Bold And Char.Font.Color = RGB(0, 0, 255) Then
                        Char.Font.Color = RGB(0, 0, 0)
                     End If
                 Next Char


            End If
        End If
    End If


    Set objItem = Nothing
    Set objWord = Nothing
    Set objSel = Nothing
    Set objInsp = Nothing
End Sub

This is a follow up to question: Programmatically change font properties in email body


Solution

  • first of all: don't use On Error Resume Next when you're trying to debug your code. It makes your life harder.

    second: use Option Explicit at the beginning of the module. With that option enabled, VBA will show you every variable that's not initialized (some bugs only occur from misspellings).

    I've corrected your code, so it works for me:

    Public Sub FormatSelectedText()
        Dim objOutlook As Outlook.Application ' i used this because im working in MS Access
        Dim objItem As Object
        Dim objInsp As Outlook.Inspector
    
        ' Add reference to Word library
        ' in VBA Editor, Tools, References
        Dim objWord As Word.Application
        Dim objDoc As Word.Document
        Dim objSel As Word.Selection
        Dim objChar As Object
        Dim Char As Object
    
        'Reference the current Outlook item
        Set objOutlook = GetObject(, "Outlook.Application")
        Set objItem = objOutlook.ActiveInspector.CurrentItem
        If Not objItem Is Nothing Then
            If objItem.Class = olMail Then
                Set objInsp = objItem.GetInspector
                If objInsp.EditorType = olEditorWord Then
    
                    Set objDoc = objInsp.WordEditor
                    Set objWord = objDoc.Application
                    Set objSel = objWord.Selection
                    Set objChar = objSel.Characters ' this wasn't initialized
    
                    ' replace the With block with your code
    '                   With objChar ' you don't Need this block because objChar is an array and it throws an error when you try to use this code on the whole objChar object
    '                   ' Formatting code goes here
    '                        '.Font.Size = 18
    '                        If .Font.Bold = True Then
    '                            .Font.color = wdColorBlue
    '                        End If
    '                        .Font.color = wdColorRed
    '                        '.Font.Italic = True
    '                        '.Font.Name = "Arial"
    '                   End With
    
                     For Each Char In objSel.Characters
                         If Char.Font.Bold Then
                            Char.Font.color = rgb(255, 0, 0) 'TextRGBTmp (the rgb was filled backwards, so the text became blue. i fixed it.
                         End If
                     Next Char
    ' the code of the second For Each was not neccessary.
    
                End If
            End If
        End If
    
    
        Set objItem = Nothing
        Set objWord = Nothing
        Set objSel = Nothing
        Set objInsp = Nothing
    End Sub