How to Subscribe to Email by Excel?

Question

I have a code to copy the page from Excel, but I can’t put my signature.

Sub Send_Range_Or_Whole_Worksheet_with_MailEnvelope_SI()
'Working in Excel 2002-2016
    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim rng As Range

    On Error GoTo StopMacro

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

    'Fill in the Worksheet/range you want to mail
    'Note: if you use one cell it will send the whole worksheet
    Set Sendrng = Worksheets("QUADRO_SI").Range("A1:Z296")

    'Remember the activesheet
    Set AWorksheet = ActiveSheet

    strbody = "Prezados" & vbNewLine & vbNewLine & _
              "" & vbNewLine & _
              "Segue situação atualizada do Zoneamento das SIs, ver abaixo:" & vbNewLine & _
              "" & vbNewLine & _
              ""

XDATE = Date

    With Sendrng

        ' Select the worksheet with the range you want to send
        .Parent.Select

        'Remember the ActiveCell on that worksheet
        Set rng = ActiveCell

        'Select the range you want to mail
        .Select

        ' Create the mail and send it
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope

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

            With .Item


                   .To = ""


    .Cc = ""
    .BCC = ""
                .Subject = "Acompanhamento do relatório de Zoneamento das SIs - " & XDATE
                '.HTMLBody = "<P>Prezados,</P>" & "Segue relatório de Alarmes extraidos no PAIOL nessa semana, em anexo." & "<br>" & .HTMLBody
                .Attachments.Add ("d:\Relatório de SIs.pdf")
                .Send
            End With

        End With

        'select the original ActiveCell
        rng.Select

    End With

    'Activate the sheet that was active before you run the macro
    AWorksheet.Select

StopMacro:

    With Application

        .ScreenUpdating = True
        .EnableEvents = True

    End With
    ActiveWorkbook.EnvelopeVisible = False

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub