Почта каждый лист с другой подписью использовать Excel VBA

Question

мне нужна твоя помощь приведенный ниже код работает для отправки электронной почты для листов мой вопрос? как я могу изменить подпись автоматически? у меня есть имя подписи в файле Excel, давайте назовем его (b2). можно ли это сделать? Примечание: я использую Excel 365 и вдов 10

Sub Mail_Every_Worksheet()
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
 TempFilePath = Environ$("temp") & "\"

        'You use Excel 2007-2016
        FileExtStr = ".xls": FileFormatNum = 52


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

    Set OutApp = CreateObject("Outlook.Application")

    For Each sh In ThisWorkbook.Worksheets

        If sh.Range("A2").Value Like "?*@?*.?*" Then

           sh.Copy
            Set wb = ActiveWorkbook

            TempFileName = sh.Name

            Set OutMail = OutApp.CreateItem(0)


            With wb

               .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

                On Error Resume Next

                With OutMail

                .Attachments.Add wb.FullName

                .Display

                strbody = "HI sony "



                    .to = sh.Range("A2").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "This is the Subject line"
                    .HTMLBody = "HI sony " & "<br>" & .HTMLBody
                    .Send



                    'You can add other files also like this
                    '.Attachments.Add ("C:\test.txt")


                End With
                On Error GoTo 0

                .Close savechanges:=False
            End With

            Set OutMail = Nothing

            Kill TempFilePath & TempFileName & FileExtStr

        End If
    Next sh

    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Answer 1

Если вы просто хотите добавить подпись по умолчанию, отобразите электронное письмо перед отправкой:

.Display
.HTMLBody = strbody & "<br>" & .HTMLBody
.Send

Если, однако, вы хотите использовать определенный файл подписи, вам нужно прочитать этот файл:

SigString = Environ("appdata") & "\Microsoft\Signatures\B2.htm"
If Dir(SigString) = "" Then
    OutSignature = ""
Else
    Dim fso As Object
    Dim sf As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set sf = fso.GetFile(SigString).OpenAsTextStream(1, -2)
    OutSignature = sf.readall
    sf.Close
End If
.HTMLBody = strbody & "<br>" & OutSignature
.Send

Я использую Excel 2013, хотя этот ответ не должен ограничиваться этой версией.