通过vba发送htm签名的电子邮件发送所选范围

Question

我需要通过电子邮件从excell发送选择范围并从htm文件添加签名。我有下一个代码来发送选择，它运作良好：

Sub Send_Selection()
'Working in Excel 2002-2013
    Dim Sendrng As Range
       Dim strbody As Range
    On Error GoTo StopMacro

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

    'Note: if the selection is one cell it will send the whole worksheet
    Set Sendrng = Selection

    'Create the mail and send it
    With Sendrng

        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope

            ' Set the optional introduction field thats adds
            ' some header text to the email body.
            .Introduction = ""

            With .Item
                .To = "dg@siz66.ru"
                .CC = ""
                .BCC = ""
                .Subject = "My subject"
                .send
            End With

        End With
    End With
StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False

End Sub

接下来，我有代码来生成带有html文件签名的邮件：

Sub Mail_Outlook_With_Signature_Html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String

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

    'Change only Mysig.htm to the name of your signature
    SigString = "C:\Users\d.gazdovsky\Downloads\sign.htm"

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

    On Error Resume Next

    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody & "<br>" & Signature
        .display    'or use .Display
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = 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

现在我只需要结合这些宏来解决我的问题。请帮帮我。提前致谢

UPD 1：我尝试了这段代码，但它给出了错误..

Sub Mail_Outlook_With_Signature_Html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Sendrng As Range
    Dim strbody As Range



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

    'Note: if the selection is one cell it will send the whole worksheet
    Set Sendrng = Selection & Signature

    'Create the mail and send it
    With Sendrng

        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope

            ' Set the optional introduction field thats adds
            ' some header text to the email body.
            .Introduction = ""

            With .Item
                .To = "dg@siz66.ru"
                .CC = ""
                .BCC = ""
                .Subject = "My subject"
                .send
            End With

        End With
    End With

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

    'Change only Mysig.htm to the name of your signature
    SigString = "C:\Users\d.gazdovsky\Downloads\sign.htm"

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

    On Error Resume Next

    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        '.HTMLBody = Sendrng & "<br>" & Signature
        .display    'or use .Display
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = 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