下面是一个简单的示例，该示例将复制整个Word文档并使用strbody

Option Explicit
Public Sub Example()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim rng As Range
    Dim Word As New Word.Application
    Dim WordDoc As New Word.Document
    Dim Doc As String
    Dim strbody As String

    Doc = Range("E37").Text
    Set WordDoc = Word.Documents.Open(Doc, ReadOnly:=True)
        Word.Selection.WholeStory
        strbody = Word.Selection

    Debug.Print strbody

    WordDoc.Close
    Word.Quit

    Set sh = Sheets("Daten")
    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

        If cell.Value Like "?*@?*.?*" And _
            Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .To = cell.Value
                .CC = ""
                .Subject = Range("F1").Value
                .HTMLBody = "<br>" & Range("A45").Value & _
                            "<br>" & strbody & "<br>" & .HTMLBody

                .Display 'here
            End With
        End If
    Next 'cell

End Sub

要保留格式和签名，请尝试以下示例

Option Explicit
Public Sub Example()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim rng As Range
    Dim Word As New Word.Application
    Dim WordDoc As Word.Document
    Dim wdDoc As Word.Document
    Dim Doc As String
    Dim strbody As Variant ' String

    Doc = Range("E37").Text
    Set WordDoc = Word.Documents.Open(Doc, ReadOnly:=True)

    Word.Selection.WholeStory
    Word.Selection.Copy

    WordDoc.Close
    Word.Quit

    Set sh = Sheets("Daten")
    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

        If cell.Value Like "?*@?*.?*" And _
            Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)
            Set WordDoc = OutMail.GetInspector.WordEditor

            With OutMail
                .To = cell.Value
                .CC = ""
                .Subject = Range("F1").Value
                .Display 'here

                 WordDoc.Paragraphs(1).Range. _
                         InsertBefore sh.Range("A45").Value

                 WordDoc.Paragraphs(2).Range. _
                         PasteAndFormat Type:=wdFormatOriginalFormatting
            End With
        End If
    Next 'cell
End Sub