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
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
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