使用 excel vba 发送具有不同签名的每个工作表答案

【问题标题】：Mail every worksheet with Different signature use excel vba使用 excel vba 发送具有不同签名的每个工作表
【发布时间】：2020-06-21 07:05:30
【问题描述】：

我需要你的帮助下面的代码可以为我的问题发送电子邮件吗？我怎样才能自动更改签名？我在 excel 文件中有签名的名称，我们称之为 (b2)。有可能做到吗？注意：我使用 excel 365 和 widows 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

【问题讨论】：

标签： excel vba outlook

【解决方案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，但此答案不应仅限于该版本。

【讨论】：