使用VBA以编程方式更改Outlook中电子邮件正文中的属性

时间:2015-07-07 08:05:36

标签: vba email outlook outlook-vba outlook-2010

我已准备好在Outlook 2013中发送电子邮件 我想扫描电子邮件的正文以获取粗体文本(即粗体字符)并将其颜色更改为红色 (很高兴)从宏中排除签名

我把下面的代码放在一起,但仍然无法正常工作。有什么想法吗?

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

这是问题的后续问题:Programmatically change font properties in email body

1 个答案:

答案 0 :(得分:2)

首先:在尝试调试代码时不要使用On Error Resume Next。它会让你的生活更加艰难。

第二:在模块的开头使用Option Explicit。启用该选项后,VBA将显示未初始化的每个变量(某些错误仅发生在拼写错误中)。

我已经更正了您的代码,因此它对我有用:

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