Question

我正在尝试发送一封电子邮件，邮件的正文由文本框的内容组成。到目前为止，我已经尝试过通过vba将字符串作为字符串插入文本框中，但是这样可以消除所有换行格式。有没有办法使文本框内容与电子邮件中的内容完全相同？

Sub Send_Email()

Dim OutApp As Object
Dim OutMail As Object

Dim title As String, emailto As String
Dim texts As String

title = Range("email_subject").Value
emailto = Range("email_to").Value
texts = Worksheets("Input").Shapes("TextBox 2").TextFrame.Characters.Text

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = emailto
    .Subject = title
    .HTMLBody = texts
    .display
End With
On Error GoTo 0

End Sub

Answer 1

请在下面找到一个可能有助于您解决问题的示例。您将拥有全局变量，该变量将保存excel工作表中的信息并在电子邮件中使用它们。如果没有关于数据外观的图像，就无法真正猜出您正在尝试做什么。也许您可以将文本分隔在不同的单元格中，这样就可以循环遍历并将它们放在不同的变量中，并且可以在SendEmail过程中构造电子邮件。或者，如果您使用相同的文本并且没有更改，则可以按照以下示例进行修改。

Option Explicit
Dim titleName As String
Dim firstName As String
Dim lastName As String
Dim fullName As String
Dim clientEmail As String
Dim ccEmail As String
Dim bccEmail As String
Dim emailMessage As String

Sub GenerateInfo()

    Dim WS As Worksheet
    Dim lrow As Long
    Dim cRow As Long

    Set WS = ActiveSheet

    With WS
        lrow = .Range("E" & .Rows.Count).End(xlUp).Row
        Application.ScreenUpdating = False
        For cRow = 2 To lrow
            If Not .Range("L" & cRow).value = "" Then
                titleName = .Range("D" & cRow).value
                firstName = .Range("E" & cRow).value
                lastName = .Range("F" & cRow).value
                fullName = firstName & " " & lastName
                clientEmail = .Range("L" & cRow).value

                Call SendEmail

                .Range("Y" & cRow).value = "Yes"
                .Range("Y" & cRow).Font.Color = vbGreen

            Else
                .Range("Y" & cRow).value = "No"
                .Range("Y" & cRow).Font.Color = vbRed
            End If
        Next cRow
    End With

    Application.ScreenUpdating = True

    MsgBox "Process completed!", vbInformation

End Sub
Sub SendEmail()

    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim sigString As String
    Dim Signature As String
    Dim insertPhoto As String
    Dim photoSize As String

    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)

    'Change only Mysig.htm to the name of your signature
    sigString = Environ("appdata") & _
                "\Microsoft\Signatures\Marius.htm"

    If Dir(sigString) <> "" Then
        Signature = GetBoiler(sigString)
    Else
        Signature = ""
    End If

    insertPhoto = "C:\Users\marius\Desktop\Presale.jpg" 'Picture path
    photoSize = "<img src=""cid:Presale.jpg""height=400 width=400>" 'Change image name here

    emailMessage = "<BODY style=font-size:11pt;font-family:Calibri>Dear " & titleName & " " & fullName & "," & _
                    "<p>I hope my email will find you very well." & _
                    "<p>Our <strong>sales preview</strong> starts on Thursday the 22nd until Sunday the 25th of November." & _
                    "<p>I look forward to welcoming you into the store to shop on preview.<p>" & _
                    "<p> It really is the perfect opportunity to get some fabulous pieces for the fast approaching festive season." & _
                    "<p>Please feel free to contact me and book an appointment." & _
                    "<p>I look forward to seeing you then." & _
                    "<p>" & photoSize & _
                    "<p>Kind Regards," & _
                    "<br>" & _
                    "<br><strong>Marius</strong>" & _
                    "<br>Assistant Store Manager" & _
                    "<p>"


    With outlookMail
        .To = clientEmail
        .CC = ""
        .BCC = ""
        .Subject = "PRIVATE SALE"
        .BodyFormat = 2
        .Attachments.Add insertPhoto, 1, 0
        .HTMLBody = emailMessage & Signature 'Including photo insert and signature
        '.HTMLBody = emailMessage & Signature 'Only signature
        .Importance = 2
        .ReadReceiptRequested = True
        .Display
        .Send

    End With

    Set outlookApp = Nothing
    Set outlookMail = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String

    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

发送邮件，邮件正文是单元格的内容，包括换行格式？

1 个答案: