我正在尝试从邮件库和文本框中从Excel中批量发送邮件。
我用正确的电子邮件地址，主题和正文创建邮件。但是，正文不考虑文本框中使用的格式。格式通常包括项目符号，颜色，粗体字符（如Word文档）。
如果我理解得很好，函数convert_RTF_to_HTML中的部分会查看每个字符并对其进行转换。
我使用了来自https://codedocu.com/Office-365/Excel/Templates/Emails?2510的部分代码
在A栏中我有名字，在B中是电子邮件地址，C是主题，D是抄送。

Sub MailAppelOffre()
    Dim i As Integer
    Dim name, email, body, subject, copy As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    body = ActiveSheet.TextBoxes("ZoneTexte 1").Text 'ZoneTexte 1 is TextBox 1
    
    i = 2
    'Loop down name column starting at row 2 column 1
    Do While Cells(i, 1).Value <> ""
        
        name = Cells(i, 1)
        email = Cells(i, 2).Value
        subject = Cells(i, 3).Value
        copy = Cells(i, 4).Value
        
        'replace place holders
        body = Replace(body, "C1", name)
    
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = email
            .cc = copy
            .subject = subject
            .body = body
            '.Attachments.Add ("")
            .Display
            '.Send
        End With
        
        'reset body text
        body = ActiveSheet.TextBoxes("TextBox 1").Text
        
        i = i + 1
    Loop

    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

编辑：我试图从下面的codedocu实现部分，但没有成功运行它。

Sub GenMail()
    Dim i As Integer
    Dim varTeamname As Variant
    Dim varEmail As Variant
    Dim varBody As Variant
    Dim varSubject As Variant
    Dim strCopy As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    i = 2
    'Loop down name column starting at row 2 column 1
    Do While Cells(i, 1).Value <> ""
        
        varTeamname = Cells(i, 1) 'name of teams are in column 1
        varEmail = Cells(i, 2).Value 'email of teams are in column 2
        varSubject = Cells(i, 3).Value 'subject of mails are in column 3
        strCopy = Cells(i, 4).Value 'CC are in column 4
        
        varBody = ActiveSheet.TextBoxes("ZoneTexte 1").text
        varBody = convert_RTF_to_HTML(varBody)
        varBody = Replace(varBody, "C1", name)
    
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
             .To = varEmail
             .CC = strCopy
             .subject = varSubject
             .HTMLBody = varBody
             .Display
        End With
        
        i = i + 1
    Loop

    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

Public Function convert_RTF_to_HTML(ByVal parCharacters As Variant) As String

    '------< RTF in HTML Conversion >--------
    Dim sHTML As String
    sHTML = ""
    Dim bChange As Boolean
    
    Dim intColor As Long
    intColor = 0
    Dim intRed As Long, intGreen As Long, intBlue As Long
    
    Dim sFontName As String
    sFontName = ""
    Dim sFontSize As String
    sFontSize = ""
    Dim sUnderline As String
    sUnderline = ""
    
    Dim bBold As Integer
    bBold = 0
    
    '------< @Loop: Characters >------
    Dim varChar
    For Each varChar In parCharacters
        '----< Character >----
        bChange = False
        
        '< get Character >
        Dim char_Text As String
        char_Text = varChar.Text
        
        Dim char_FontName As String
        char_FontName = varChar.Font.name
        
        Dim char_FontSize As String
        char_FontSize = varChar.Font.Size
        
        Dim char_Underline As String
        char_Underline = varChar.Font.UnderlineStyle
        
        Dim char_RGB As Long
        char_RGB = varChar.Font.Fill.ForeColor.RGB
        
        Dim char_Bold As Integer
        char_Bold = varChar.Font.Bold
        '</ get Character >
        
        '< Font >
        If Not sFontName Like char_FontName Then
            bChange = True
            sFontName = char_FontName
        End If
        '</ Font >
        
        '< FontSize >
        If Not sFontSize Like char_FontSize Then
            bChange = True
            sFontSize = char_FontSize
        End If
        '</ FontSize >
        
        '< Underline >
        If Not sUnderline Like char_Underline Then
            bChange = True
            sUnderline = char_Underline
        End If
        '</ Underline >
        
        '< Color >
        If Not intColor Like char_RGB Then
            bChange = True
            intColor = char_RGB
            intRed = (intColor And &HFF) \ 256 ^ 0      ' &HFF hexadecimal = 255 decimal
            intGreen = (intColor And &HFF00&) \ 256 ^ 1   ' &HFF00& hexadecimal = 65280 decimal
            intBlue = intColor \ 256 ^ 2
        End If
        '</ Color >
        
        '< Bold >
        If Not bBold Like char_Bold Then
            bChange = True
            bBold = char_Bold
        End If
        '</ Bold >
        
        '< Korrekturen >
        char_Text = Replace(char_Text, vbCrLf, "<br>")
        char_Text = Replace(char_Text, vbLf, "<br>")
        
        '</ Korrekturen >
        
        '< Formatierung HTML >
        If bChange Then
            sHTML = sHTML & "</span>"
            sHTML = sHTML & vbCrLf & "<span style="""
            sHTML = sHTML & " font-family:" & sFontName & ";"
            sHTML = sHTML & " font-size:" & sFontSize & "pt;"
            If Not sUnderline Like "0" Then
                sHTML = sHTML & " text-decoration:underline;"
            End If
            sHTML = sHTML & " color:rgb(" & intRed & "," & intGreen & "," & intBlue & ") ;"
            If bBold <> 0 Then
                sHTML = sHTML & " font-weight:font-weight: bold;"
            Else
                sHTML = sHTML & " font-weight:font-weight: normal;"
            End If
            sHTML = sHTML & """>"
        End If
        '</ Formatierung HTML >
        
        '< Text_anfuegen >
        sHTML = sHTML & char_Text
        '</ Text_anfuegen >
        '----</ Character >----
    Next
    '------</ @Loop: Characters >------
    '< Korrektur >
    sHTML = sHTML & "</span>"
    '</ Korrektur >
    '</ Text >
    
    convert_RTF_to_HTML = sHTML
    '------</ RTF in HTML umwandeln >--------
End Function