Estoy creando un correo electrónico usando VBA en Excel. Para el cuerpo del correo electrónico, estoy tomando el valor de un TextBox en la hoja de Excel. He habilitado varias líneas en TextBox y he puesto texto en la primera línea y tengo texto en la línea de abajo, pero cuando genero el correo electrónico, toma ambas líneas de texto y las coloca en la misma línea en el correo electrónico.

Necesito saber cómo mantener los saltos de línea en TextBox.

Sub Test1()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim SigString As String
Dim Signature As String

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
       LCase(Cells(cell.Row, "C").Value) = "yes" Then

        Set OutMail = OutApp.CreateItem(0)

        SigString = Environ("appdata") & _
            "\Microsoft\Signatures\Default.htm"

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

        On Error Resume Next
        With OutMail
            .Display
            .To = cell.Value
            .Subject = "Reminder"
            .HTMLBody = "<p>Dear " & Cells(cell.Row, "A").Value & ",</p>" _
                  & "<br><br>" & ActiveSheet.TextBox1.Value & _
                  .HTMLBody               
            .Attachments.Add ("")
            .Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing
    End If
Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    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

enter image description here

Aquí están las propiedades TextBox1 ingrese la descripción de la imagen aquí

1
Matt Pierce 25 feb. 2020 a las 20:32

2 respuestas

La mejor respuesta

Puede reemplazar sus líneas nuevas, vbNewLine, con saltos de línea con formato HTML, <br>, de esta manera:

With outMail
    .display
    .To = Cell.Value
    .subject = "Reminder"
    .HTMLBody = "<p>Dear " & Cells(Cell.row, "A").Value & ",</p>" _
          & "<br><br>" & Replace(ActiveSheet.TextBox1.Value, vbNewLine, "<br>") & _
          .HTMLBody
    .Attachments.Add ("")
    .display
End With
1
Josh Eller 25 feb. 2020 a las 17:52

Puedes Split tu cadena aquí para separar las líneas


 .HTMLBody = "<p>Dear " & Cells(cell.Row, "A").Value & ",</p>" _
             & "<br><br>" _
             & Split(ActiveSheet.TextBox1.Value, ".")(0) &"."  _
             & "<br>" _
             & Split(ActiveSheet.TextBox1.Value, ".")(1) & "."  _
             & .HTMLBody               
1
urdearboy 25 feb. 2020 a las 17:51