Email to include Outlook signature (1 Viewer)

M

miacino

Registered User.
Local time
Yesterday, 17:04
Joined
Jun 5, 2007
Messages
106
I have a code to send an email through Outlook looking up emails from a table.
Is there a way to include my Outlook signature?

-----------
Private Sub Command272_Click()
Dim strFileName As String
Dim rst As DAO.Recordset
Dim strEMailTo As String
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set rst = CurrentDb.OpenRecordset("select ContactEmail from Contacts where [2_Comm_OfferRecd] = True ")

rst.MoveFirst

Do While Not rst.EOF
strEMailTo = strEMailTo & "; " & rst!ContactEmail
rst.MoveNext

Loop
With MailOutLook
.To = strEMailTo
.Subject = "Signed Offer Received"
.HTMLBody = "<HTML><BODY><font face=Calibri>Good afternoon,<BR><BR>I have received the signed agreement from the following:"
.HTMLBody = .HTMLBody & "<BR><BR>-Employee: " & [PhysicianHired]
.HTMLBody = .HTMLBody & "<BR>-Department: " & [Division]
.HTMLBody = .HTMLBody & "<BR>-Manager: " & [HiringMgr]
.HTMLBody = .HTMLBody & "<BR>-Start Date: " & [Actual Start Date]
.HTMLBody = .HTMLBody & "<BR><BR>Jessica - CV Attestation attached for your process; please update me with the new EE#.<BR><BR>CV attached for all as well.<BR><BR>Thanks!<BR>Michele</b></font></BODY></HTML>"
.Display 'Used during testing without sending (Comment out .Send if using this line)
End With
End Sub
 
M

miacino

Registered User.
Local time
Yesterday, 17:04
Joined
Jun 5, 2007
Messages
106
Thank you. I will try and incorporate into my code, however, may be a little over my head. :rolleyes:
 
theDBguy

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 17:04
Joined
Oct 29, 2018
Messages
21,454
Hi,


You're using .Display in your code. If you set up Outlook to auto-include your signature, does it not show up when you run your code and the email is displayed (not sent)?


Just curious...
 
June7

June7

AWF VIP
Local time
Yesterday, 16:04
Joined
Mar 9, 2014
Messages
5,466
The default signature seems to get lost when using Outlook automation if you simply set the Email body. Have to concatenate the HTMLBody generated with the default signature to the constructed body text.

Have to use .Display for this to work. It must precede the line setting HTMLBody.

Then if want to auto send, follow with .Send.


I have tried the GetBoiler() function in the referenced link and could not get to work.
 
Last edited:
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 01:04
Joined
Sep 21, 2011
Messages
14,238
I think the problem is the the o/p is wiping out the whole html with their own.?

I took the approach of finding where the body started, and replaced that with that and my html. That way it does not affect my signature.

Code: 
    'Get the signature if it exists
    If Dir(strSigPath) <> "" Then
        strSignature = GetBoiler(strSigPath)
        intBody = InStr(strSignature, "<div class=WordSection1>")
        'intBody = InStr(strSignature, "<BODY>")
        strHeader = Left(strSignature, intBody + 24) ' 5
        strFooter = Mid(strSignature, intBody + 24) ' 6
    End If

'Lots of code


            .HTMLBody = strHeader & "<table border = '0' cellpadding = '5' cellspacing = '5'>"


                .HTMLBody = .HTMLBody & strPad & str3rdPartyType & strPadCol & str3rdParty & strEndPad
                .HTMLBody = .HTMLBody & strPad & strDatetype & strPadCol & strDate & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Method:" & strPadCol & strMethod & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Reference:" & strPadCol & strRef & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Amount:" & strPadCol & strAmount & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Balance:" & strPadCol & strBalance & strEndPad

theDBguy said:
Hi,


You're using .Display in your code. If you set up Outlook to auto-include your signature, does it not show up when you run your code and the email is displayed (not sent)?


Just curious...
Click to expand...
 
M

miacino

Registered User.
Local time
Yesterday, 17:04
Joined
Jun 5, 2007
Messages
106
Again, thank you all for your continued efforts. Again, this is simply above my scope.. Gasman, not sure where to post that code, after my code End If?
It does not recognize "GetBoiler".

I thought adding the Outlook signature might be a simple task, obviously not. In a little over my head! Thanks for your time.
Michele
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 01:04
Joined
Sep 21, 2011
Messages
14,238
That was not meant to be copy and paste code, just an example on how to go about it.

I probably copied a lot from that link already posted for you.

Here it is again.

https://www.rondebruin.nl/win/s1/outlook/signature.htm

However that was when I was using 2003 and unable to send using another account, so I used a template to do so.?

This is how I have done it recently when using default account.
Code: 
Sub Mail_Attachment(pStrToNames As String, pstrFilename As String, pstrSubject, pstrMessage As String)

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strSignature As String, strBody As String, strDiv As String
    Dim strGreeting As String, strTimeLimit As String
    Dim iTime As Integer
    
    strTimeLimit = "Please note, invoices should be submitted by 10 AM the following Friday to ensure prompt payment."
    strTimeLimit = strTimeLimit & " Invoices received after this time will be paid the following week."
    
    strGreeting = "Good "
    iTime = Val(Format(Now(), "hh"))
  
    Select Case iTime
    Case Is < 12
        strGreeting = strGreeting & "morning,"
    Case Is < 17
        strGreeting = strGreeting & "afternoon,"
    Case Else
        strGreeting = strGreeting & "evening,"
    End Select

    strDiv = "<div class=WordSection1>"
    strBody = "<p>" & strGreeting & "</p>" & pstrMessage
    ' Now comes from email table
    'strBody = strBody & "<p>" & strTimeLimit & "</p><p>"
    strBody = strBody & "<p>Should there be any queries please let me know.</p>"

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With OutMail
        .Display
    End With
    With OutMail
        .to = pStrToNames
       .BCC = ""
        .Subject = pstrSubject
        .htmlbody = Replace(.htmlbody, strDiv, strDiv & strBody)
        '.attachments.Add pstrFilename & ".pdf"
        .attachments.Add pstrFilename
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

With this method I 'insert' my code into the email, so as not to affect the rest of it.

HTH
miacino said:
Again, thank you all for your continued efforts. Again, this is simply above my scope.. Gasman, not sure where to post that code, after my code End If?
It does not recognize "GetBoiler".

I thought adding the Outlook signature might be a simple task, obviously not. In a little over my head! Thanks for your time.
Michele
Click to expand...
 
S

sxschech

Registered User.
Local time
Yesterday, 17:04
Joined
Mar 2, 2010
Messages
792
This is an sample/example from the code that I use in my application. Haven't had an issue with the boiler signature not working, then again, I haven't tried .Send, as I prefer to review the email and sometimes add/edit parts of it before sending out as that is easier than trying to code for exceptions. Of course, if I were sending out lots of emails, I may reconsider, but for the quantity I do, this method has been sufficient for my purpose.

Code: 
Private Sub SendToOutLook(forwardto As String)
'Send email if their are questions regarding comments
'20180712
'Public Sub sendEmail_2()
'Code to add signature to email
'http://www.rondebruin.nl/win/s1/outlook/signature.htm
'20160826
    Dim objOutlook As Object    'Use for late binding
    Dim objNameSpace As Object  'Use for late binding
    Dim MailOutLook As Object   'Use for late binding
    Dim stBody As String
    Dim SigString As String
    Dim Signature As String
    Dim stCC As String
    Dim stSubject As String
    Dim stSQL As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim yesno
    
    'Check if should send an email if an email was previously sent
    'for this document number
    
    
    'Set db = CurrentDb
    'Set rs = db.OpenRecordset("tblEMailLog")
    
    '*************************************************
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    
    If objOutlook Is Nothing Then
        Set objOutlook = CreateObject("Outlook.Application")
    End If
    '*****************************************************
    
    Set MailOutLook = objOutlook.CreateItem(0)  'Late binding method
    
    stSubject = Me.txtSubject
    stBody = "Hi " & ",<br><br>" & _
             "For information only, as you weren't cc'd on this email. " & _
             "<br><br>Thanks,<br>"
        
    'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\sxsch.htm"
    
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
    
    On Error Resume Next
    
    With MailOutLook
        .bodyformat = 3      'Late binding in lieu of olFormatRichText
        .To = forwardto 'ConcatRelated("email", "tblEmail", "distributiontype='To'", , ";") '"sxsch@emailaddress.com"
        '.CC = ConcatRelated("email", "tblEmail", "distributiontype='cc'", , ";")
        '.bcc = ""
        .Subject = stSubject 'Me.txtUCASEFilename
        .htmlbody = stBody & "<br>" & Signature
        '.Send
        .display  'Use for testing in lieu of .Send
    End With
    On Error GoTo 0
    
    'Add record to email log
    'rs.AddNew
    'rs!DocumentNumber = Me.DocumentNumber
    'rs!SentTo = ConcatRelated("FullName", "tblEmail", "distributiontype='To'", , "; ")
    'rs!SentDate = Now()
    'rs.Update
    'frmProCore_Sub.Requery
Finished:
    Set MailOutLook = Nothing
    Set objOutlook = Nothing
    Set rs = Nothing
    Set db = Nothing
End Sub

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
'http://www.rondebruin.nl/win/s1/outlook/signature.htm
'20160826
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function
 
You must log in or register to reply here.

Similar threads

J
Save Email to Directory
2 3
Replies
58
Views
2,507
johankotze
J
M
Solved VBA access to outlook email with table: aligning table cells
Replies
5
Views
1,878
miacino
M
M
Add Signature to Email body
Replies
2
Views
746
Momma
M
T
HTML EMAIL
Replies
6
Views
760
cheekybuddha
cheekybuddha
A
Solved Help with handling of Null
2 3
Replies
53
Views
2,269
allen675
A

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom