Question

我有自动发送电子邮件的useform。我想更改电子邮件的正文 - 其中一些将基于带有文本的单元格，因此它可能是动态的，有些将在代码中修复。现在 - 在给我一个错误的对象需要，我会感谢你的帮助。我希望电子邮件正文中的每一行都是分开的。

Sub sendMail(ByVal mail As String, name As String, Msht As Worksheet, CCmail As Integer, CCperson As String)
    Dim applOL As Outlook.Application
    Dim miOL As Outlook.MailItem
    Dim recptOL As Outlook.Recipient
    mailSub = Msht.Range("J2")
    mailbody = Msht.Range("L2")
    Set applOL = New Outlook.Application
    Set miOL = applOL.CreateItem(olMailItem)
    Set recptOL = miOL.Recipients.add(mail)
    recptOL.Type = olTo
    If CCmail = 1 Then
        Set recptOL = miOL.Recipients.add(CCperson)
        recptOL.Type = olCC
    End If
    tempPath = ActiveWorkbook.Path & "\" & ActiveWorkbook.name
    With miOL
        .Subject = mailSub
        .Body = "bla bla" & "bla bla bla" & mailbody.Font.Underline & Msht.Range("M2").Font.Bold & Body = Msht.Range("N2")
        .Attachments.add (tempPath)
        .send

    End With
    ActiveWorkbook.Close Savechanges:=True
    Set applOL = Nothing
    Set miOL = Nothing
    Set recptOL = Nothing
End Sub

Answer 1

您需要将HTML格式应用于电子邮件正文：

Dim body_ As String
    body_= "<p> Hello </p>" & _
           "<p> This is a line </p>" & _
           "<p> This is another line </p>" & _
           "<p> This is yet another line. </p>"

.BodyFormat = olFormatHTML
.HTMLBody = "<html><head></head><body>" & body_ & "</body></html>"

<强>更新

Option Explicit

Public Sub sendMail(ByVal mail As String, name As String, Msht As Worksheet, CCmail As Integer, CCperson As String)
    On Error GoTo ErrorTrap

    Dim applOL As Outlook.Application
    Set applOL = New Outlook.Application

    Dim miOL As Outlook.MailItem
    Set miOL = applOL.CreateItem(olMailItem)

    Dim recptOL As Outlook.Recipient
    Set recptOL = miOL.Recipients.Add(mail)
        recptOL.Type = olTo

    Dim mailSub As String
        mailSub = Msht.Range("J2")

    Dim mailbody As String
        mailbody = "<p><u>" & Msht.Range("L2").Value & "</u></p>" & _
                   "<p><b>" & Msht.Range("M2").Value & "</b></p>" & _
                   "<p>" & Msht.Range("N2").Value & "</p>"

    If CCmail = 1 Then
        Set recptOL = miOL.Recipients.Add(CCperson)
        recptOL.Type = olCC
    End If

    Dim tempPath As String
        tempPath = ActiveWorkbook.Path & "\" & ActiveWorkbook.name

    With miOL
        .Subject = mailSub
        .BodyFormat = olFormatHTML
        .HTMLBody = "<html><head></head><body>" & mailbody & "</body></html>"
        .Attachments.Add tempPath
        .send
    End With

    ActiveWorkbook.Close Savechanges:=True

Leave:
   On Error GoTo 0
   Exit Sub

ErrorTrap:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Sub

VBA Excel Outlook电子邮件正文格式

1 个答案: