Excel VBA文本框保持换行符答案

【问题标题】：Excel VBA TextBox Keep Line BreakExcel VBA文本框保持换行符
【发布时间】：2020-06-09 12:30:56
【问题描述】：

我正在使用 Excel 中的 VBA 创建电子邮件。对于电子邮件的正文，我在 Excel 工作表中获取 TextBox 的值。我在 TextBox 中启用了多行并将文本放在第一行并在下面的行放置文本，但是当我生成电子邮件时，它需要两行文本并将它们放在电子邮件的同一行。

我需要知道如何在 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

这是 TextBox1 的属性

【问题讨论】：

您在 excel 中的文本是换行还是存在有效的换行符 (Chr(10))。如果您的文本只是被换行，则格式将不会延续，因为它会相应地调整大小。您可能必须手动 Split 您的字符串以获取电子邮件
我添加了文本框及其属性的图片。

标签： excel vba

【解决方案1】：

您可以将换行符 vbNewLine 替换为 HTML 格式的换行符 <br>，如下所示：

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

【讨论】：

【解决方案2】：

你可以在这里Split你的字符串来分隔行

 .HTMLBody = "<p>Dear " & Cells(cell.Row, "A").Value & ",</p>" _
             & "<br><br>" _
             & Split(ActiveSheet.TextBox1.Value, ".")(0) &"."  _
             & "<br>" _
             & Split(ActiveSheet.TextBox1.Value, ".")(1) & "."  _
             & .HTMLBody

【讨论】：