CODEWITHSUNDEEP
vbaexcel
StormsEdge
StormsEdge

Reputation: 885

Signature not appearing in excel automated email

Have been banging my head against this for a while now.

Created an routine to send end of day emails to customers with multiple pdf attachments. All of that is working, but for some reason the signature does not appear automatically like it normally does. I tried to capture it by setting signature = outMail.body and adding it to my standard body later on, but that doesn't seem to be working. If I open an email the normal way the signature shows up automatically as it should. Thanks in advance.

**In additional "body" used in the .body line is just a var string that contains the text for the body of the email.

'Initial signature capture
        With outMail
            .Display
        End With

        signature = outMail.body

        With outMail
            .To = firmEmail
            .Subject = ******
            .body = body & vbNewLine & vbNewLine & signature

            Do While continue = True

                'Get attachments
                If reportsByFirm.Cells(row_counter, firmcol) = cFirm Or reportsByFirm.Cells(row_counter, firmcol) = iFirm Then
                    pdfLocation = getPDFs(cFirm, iFirm, row_counter, reportsByFirm, trMaster, trSeparate, trName, reportDate)
                    .Attachments.Add (pdfLocation)
                    row_counter = row_counter + 1

                ElseIf row_counter < lRowReportsByFirm Then
                    row_counter = row_counter + 1

                ElseIf row_counter >= lRowReportsByFirm Then
                    continue = False
                End If
            Loop
            .Display
        End With

Upvotes: 3

Views: 880

Answers (1)

Simon Wray
Simon Wray

Reputation: 192

I suspect that the Signature is not initially added to a new Email, but a later step in Outlook then adds it to the Email. So your code is just creating an Email item with an empty Body.

I have used these two routines to get the Signature from the .html file it is contained in and then add that to the Email, done as html so I'm using .HTMLBody instead of .Body.

Private Sub btnGenerateEmail_Click()

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim nRow As Integer
Dim tblEmailTo As ListObject
Dim tblEmailCC As ListObject
Dim sToEmail As String
Dim sCCEmail As String
Dim sSalutation As String
Dim dteEffectiveDate  As Date
Dim sSignature As String

On Error GoTo EH

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(olMailItem)

Set tblEmailTo = ThisWorkbook.Sheets("Ref").ListObjects("TblEmailTo")
Set tblEmailCC = ThisWorkbook.Sheets("Ref").ListObjects("TblEmailCC")

For nRow = 1 To tblEmailTo.ListRows.Count
    sToEmail = sToEmail & tblEmailTo.DataBodyRange(nRow, 1).Value & "; "
Next nRow

If tblEmailTo.ListRows.Count = 1 Then
    sSalutation = "Hi " & Mid(sToEmail, 1, InStr(1, sToEmail, ".") - 1) & ","
Else
    sSalutation = "Hi All,"
End If

For nRow = 1 To tblEmailCC.ListRows.Count
    sCCEmail = sCCEmail & tblEmailCC.DataBodyRange(nRow, 1).Value & "; "
Next nRow

dteEffectiveDate = Range("C" & mnDataStartRow).Value

sSignature = GetCorpEmailSig()

OutMail.To = sToEmail
OutMail.CC = sCCEmail
OutMail.Subject = "My Email Subject as at " & Format(dteEffectiveDate, "mmmm dd yyyy")
OutMail.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & sSalutation & _
                                            "<br><br>My main email body text<br><br>Regards," & _
                                            "<br>" & Mid(Application.UserName, InStr(1, Application.UserName, ",") + 2) & "</BODY>" & sSignature

If Dir(GetOutputPath) <> "" Then
    OutMail.Attachments.Add (GetOutputPath)
End If

OutMail.Display

Set OutMail = Nothing
Set OutApp = Nothing

Exit Sub

Private Function GetCorpEmailSig() As String

Dim sSigFilename As String
Dim fso As Object
Dim ts As Object

sSigFilename = Environ("appdata") & "\Microsoft\Signatures\My Company Name.htm"

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sSigFilename).OpenAsTextStream(1, -2)
GetCorpEmailSig = ts.ReadAll
ts.Close

End Function

Upvotes: 2

Related Questions