Outlook 2007 Signature (1 Viewer)

johankotze

Registered User.
Local time
Today, 03:34
Joined
Jul 3, 2016
Messages
54
I have the following code on the ClickEvent of a button a form. I works well but I need to add the Outlook Signature it. There are quite a bit of information around this on the net but I can't get it to work.

Private Sub cmdEmail_Click()
Dim OutlookAttach As Outlook.Attachment
Dim strFileName As String
Dim strHTMLBody As String
'-------------------------------------------------------------------------------------
'The filepath for the attachment is everything to the left of the first # sign delimiter in the hyperlink
'-------------------------------------------------------------------------------------
If Not IsNull(Me.strHyperlink) Then
strFileName = Mid$(Me.strHyperlink, InStr(Me.strHyperlink, "#") + 1)
Else
strFileName = "Empty"
End If
'--------------------------------------------------------------------------------------
'Set the Outlook controls to create a new message
'--------------------------------------------------------------------------------------
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
'--------------------------------------------------------------------------------------
'Set the FROM field
'--------------------------------------------------------------------------------------
OutlookMail.SentOnBehalfOfName = strFrom
'--------------------------------------------------------------------------------------
'Set the TO, CC, BCC fields
'--------------------------------------------------------------------------------------
If Not IsNull(Me.Text96) Then
OutlookMail.To = Me.Text96
End If

If Not IsNull(Me.Text74) Then
OutlookMail.CC = Me.Text74
End If
If Not IsNull(Me.Text91) Then
OutlookMail.CC = OutlookMail.CC & ";" & Me.Text91
End If
If Not IsNull(Me.Text49) Then
OutlookMail.CC = OutlookMail.CC & ";" & Me.Text49
End If
If Not IsNull(Me.Text108) Then
OutlookMail.CC = OutlookMail.CC & ";" & Me.Text108
End If
'--------------------------------------------------------------------------------------
'Set the SUBJECT field
'--------------------------------------------------------------------------------------
OutlookMail.Subject = Me.Text61 & " (" & Me.Text105 & "/" & Me.Text81 & "/" & Me.Text65 & ")"
'--------------------------------------------------------------------------------------
'Set the ATTACHMENT field
'--------------------------------------------------------------------------------------
If strFileName <> "Empty" Then
Set OutlookAttach = OutlookMail.Attachments.Add(strFileName)
End If
'--------------------------------------------------------------------------------------
'Set strHTMLBody
'--------------------------------------------------------------------------------------
strHTMLBody = "<FONT face=Verdana size=2>" & Me.ClaimNote & "<BR>"
strHTMLBody = strHTMLBody & "<BR><BR>Groete/Regards<BR>"
'--------------------------------------------------------------------------------------
'Set the HTMLBODY field
'--------------------------------------------------------------------------------------
OutlookMail.HTMLBody = strHTMLBody & vbCrLf & Signature
'--------------------------------------------------------------------------------------
'Show the message to the user
'--------------------------------------------------------------------------------------
OutlookMail.Display
MsgBox "Email has been send successfully to " & " " & Me.Text96
End Sub
 

Isskint

Slowly Developing
Local time
Today, 01:34
Joined
Apr 25, 2012
Messages
1,302
hi

Create a template with that signature and use the CreateItemFromTemplate method.

Alternatively, use .Display earlier (after Set OutlookMail = OutlookApp.CreateItem(0)) and then assign the current body of the email (which is just the signature) to a variable - signature = OutlookMail.body. So like
Code:
Set OutlookMail = OutlookApp.CreateItem(0)
[COLOR="Blue"]OutlookMail.Display
signature = OutlookMail.body[/COLOR]
'--------------------------------------------------------------------------------------
'Set the FROM field
 

johankotze

Registered User.
Local time
Today, 03:34
Joined
Jul 3, 2016
Messages
54
Thanks Isskint Outlook Signature displayed in email. But the attachment is not attached.
 

Isskint

Slowly Developing
Local time
Today, 01:34
Joined
Apr 25, 2012
Messages
1,302
You do not have any code to assign the file path to your variable after setting it to Empty.

If the attachment location varies, then have a look at the FileDialog Property to allow the user to navigate windows explorer for the file. If the attachment name/location is the same, set your variable to it.
 

johankotze

Registered User.
Local time
Today, 03:34
Joined
Jul 3, 2016
Messages
54
Isskint, the following code is in ClickEvent of the Add File button on the form. This add the file path to the control name StrHyperlink on the form which will then be added as the attachment in the email. The strHTMLBody also do not display in the email body as per Email code.

Private Sub cmdAddFile_Click()
'First, set a Reference to the Microsoft Office XX.X Object Library

Dim strButtonCaption As String, strDialogTitle As String
Dim strHyperlinkFile As String

'Define your own Captions if necessary
strButtonCaption = "Add File"
strDialogTitle = "Select File to Create Hyperlink to"

With Application.FileDialog(msoFileDialogFilePicker)
With .Filters
.Clear
.Add "All Files", "*.*" 'Allow ALL File types
End With
'The Show Method returns True if 1 or more files are selected
.AllowMultiSelect = False 'Critical Line
.FilterIndex = 1 'Database files
.ButtonName = strButtonCaption
.InitialFileName = "\\JKBOffice-HP\Users\JKBOffice\Documents\JKBrokers\Clients"
.InitialView = msoFileDialogViewDetails 'Detailed View
.Title = strDialogTitle
If .Show Then
For Each varItem In .SelectedItems 'There will only be 1
'Extract Caption and and add Address of Hyperlink (Caption#Address)
strHyperlinkFile = Left(varItem, InStrRev(varItem, "") - 1) & "#" & varItem
Me.strHyperlink = strHyperlinkFile
Next varItem
End If
End With

End Sub

Now I really do not have a glue how to assign the file path in the Email code so that the file will be attached.
 
Last edited:

Isskint

Slowly Developing
Local time
Today, 01:34
Joined
Apr 25, 2012
Messages
1,302
Hi John

just an amendment to your code from 'Set the ATTACHMENT field. I have used StrHyperlink instead of strFileName

Code:
'Set the ATTACHMENT field
'--------------------------------------------------------------------------------------
If Not IsNull(StrHyperlink) Then
OutlookMail.Attachments.Add(StrHyperlink)
End If
 

johankotze

Registered User.
Local time
Today, 03:34
Joined
Jul 3, 2016
Messages
54
Isskint I change the code between brackets to StrFileName and the attachment works, like

'Set the ATTACHMENT field
'--------------------------------------------------------------------------------------
If Not IsNull(StrHyperlink) Then
OutlookMail.Attachments.Add(StrFilename)
End If

But now the signature looks funny, like below, not HTML anymore I think

Groete/Regards
Email Sig Johan Kotzé 0826583465 EmailLogo Is an authorised financial services provider (FSP#: 46740) 7 Barlinka street Riebeek Kasteel 7307 South Africa P.O. Box 181 Riebeek Kasteel 7307 South Africa Tel022 4481738 Fax 086 6681738Cell082 6583465
 

johankotze

Registered User.
Local time
Today, 03:34
Joined
Jul 3, 2016
Messages
54
Outlook Signature displays for a second then disappear.This happen when I add the attachment code.

Private Sub cmdEmail_Click()
Dim OutlookAttach As Outlook.Attachment
Dim strFileName As String
Dim strHTMLBody As String
'-------------------------------------------------------------------------------------
'The filepath for the attachment is everything to the left of the first # sign delimiter in the hyperlink
'-------------------------------------------------------------------------------------
If Not IsNull(Me.strHyperlink) Then
strFileName = Mid$(Me.strHyperlink, InStr(Me.strHyperlink, "#") + 1)
Else
strFileName = "Empty"
End If
'--------------------------------------------------------------------------------------
'Set the Outlook controls to create a new message
'--------------------------------------------------------------------------------------
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
OutlookMail.Display
signature = OutlookMail.Body
'--------------------------------------------------------------------------------------
'Set the FROM field
'--------------------------------------------------------------------------------------
OutlookMail.SentOnBehalfOfName = strFrom
'--------------------------------------------------------------------------------------
'Set the TO, CC, BCC fields
'--------------------------------------------------------------------------------------
If Not IsNull(Me.Text96) Then
OutlookMail.To = Me.Text96
End If

If Not IsNull(Me.Text74) Then
OutlookMail.CC = Me.Text74
End If
If Not IsNull(Me.Text91) Then
OutlookMail.CC = OutlookMail.CC & ";" & Me.Text91
End If
If Not IsNull(Me.Text49) Then
OutlookMail.CC = OutlookMail.CC & ";" & Me.Text49
End If
If Not IsNull(Me.Text108) Then
OutlookMail.CC = OutlookMail.CC & ";" & Me.Text108
End If
'--------------------------------------------------------------------------------------
'Set the SUBJECT field
'--------------------------------------------------------------------------------------
OutlookMail.Subject = Me.Text61 & " (" & Me.Text105 & "/" & Me.Text81 & "/" & Me.Text65 & ")"
'--------------------------------------------------------------------------------------
'Set the ATTACHMENT field
'--------------------------------------------------------------------------------------
If Not IsNull(strHyperlink) Then
OutlookMail.Attachments.Add (strFileName)
End If
'--------------------------------------------------------------------------------------
'Set strHTMLBody
'--------------------------------------------------------------------------------------
strHTMLBody = "<FONT face=Verdana size=2>" & Me.ClaimNote & "<BR>"
strHTMLBody = strHTMLBody & "<BR><BR>Groete/Regards<BR>"
'--------------------------------------------------------------------------------------
'Set the HTMLBODY field
'--------------------------------------------------------------------------------------
OutlookMail.HTMLBody = strHTMLBody & vbCrLf & signature
'--------------------------------------------------------------------------------------
'Show the message to the user
'--------------------------------------------------------------------------------------
OutlookMail.Display
MsgBox "Email has been send successfully to " & " " & Me.Text96
End Sub
 

Minty

AWF VIP
Local time
Today, 01:34
Joined
Jul 26, 2013
Messages
10,374
Can you please use code tags around your code it makes it much easier to read.
You don't appear to be setting the format to HTML.

What happens if you copy the code I posted directly and don't add the attachment. I know it works with an attachment as I use similar code to send invoices out.

Also build your variables Subject, CC , Body etc outside the Outlook application method then set them all in one go it will make your process much tidier.

You are also not declaring all your variables and objects - add Option Explicit to the top of all your code modules.
 

johankotze

Registered User.
Local time
Today, 03:34
Joined
Jul 3, 2016
Messages
54
Hi Minty, your code works with out the attachment part. I can't get the font to change to Verdana 10pts though

Code:
Private Sub cmdEmail_Click()
    Dim sMsgSave        As String
    Dim sEmailAdd       As String
    Dim Variable_To     As String
    Dim Variable_Subject As String
    Dim Variable_Body   As String
    Dim signature       As String
    Dim OutApp          As Object
    Dim OutMail         As Object

    sMsgSave = Me.ClaimNote         'Mines pulled from a table and then formatted to look better in the email"
    Variable_To = Me.Text96
    Variable_Subject = Me.Text61 & " (" & Me.Text105 & "/" & Me.Text81 & "/" & Me.Text65 & ")"    '[U]Replace crlf with <b>[/U] in the html otherwise it looks rubbish"
    sMsgSave = Replace(sMsgSave, vbCrLf, "<br>")

    Variable_Body = "<br><style> " & _
                    "p {font-size:10pt; font-family:Verdana; color:Black}" & _
                    "</style>" & _
                    "<p>" & sMsgSave & "<br/>"

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail                               ' This creates a blank email and captures the users default signature.
        .BodyFormat = 2                        ' 2 = HTML format
        .Display
    End With

    signature = OutMail.HTMLBody

    With OutMail

        .To = Variable_To
        .CC = ""
        .BCC = ""
        .Subject = Variable_Subject
        '.Attachments.Add (sPath)
        .HTMLBody = Variable_Body & signature
        .Display                               'or use .Send
        .ReadReceiptRequested = False
    End With
End Sub
 

Minty

AWF VIP
Local time
Today, 01:34
Joined
Jul 26, 2013
Messages
10,374
Okay - worry about the HTML pretty's later ;)
Add your attachment at the variable sPath and uncomment the .Attachments.Add line and see if it still works.
 

johankotze

Registered User.
Local time
Today, 03:34
Joined
Jul 3, 2016
Messages
54
Hi Minty, I added the attachment code but no success

Code:
Private Sub Command119_Click()
    Dim sMsgSave        As String
    Dim sEmailAdd       As String
    Dim Variable_To     As String
    Dim Variable_Subject As String
    Dim Variable_Body   As String
    Dim signature       As String
    Dim OutApp          As Object
    Dim OutMail         As Object
    Dim OutlookAttach As outlook.Attachment
    Dim strFileName As String
    
    ' The filepath for the attachment
    ' ---------------------------------------------------
    If Not IsNull(Me.strHyperlink) Then
    strFileName = Mid$(Me.strHyperlink, InStr(Me.strHyperlink, "#") + 1)
    Else
    strFileName = "Empty"
    End If

    sMsgSave = Me.ClaimNote         'Mines pulled from a table and then formatted to look better in the email"
    Variable_To = Me.Text96
    Variable_Subject = Me.Text61 & " (" & Me.Text105 & "/" & Me.Text81 & "/" & Me.Text65 & ")"    'Replace crlf with <b> in the html otherwise it looks rubbish"
    sMsgSave = Replace(sMsgSave, vbCrLf, "<br>")

    Variable_Body = "<br><style> " & _
                    "p {font-size:10pt; font-family:Verdana; color:Blue}" & _
                    "</style>" & _
                    "<p>" & sMsgSave & "<br/>"
                    
    'Set the ATTACHMENT field
    '---------------------------------------------------------------------
   If Not IsNull(strHyperlink) Then
   OutlookMail.Attachments.Add (strFileName)
   End If

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail                               ' This creates a blank email and captures the users default signature.
        .BodyFormat = 2                        ' 2 = HTML format
        .Display
    End With

    signature = OutMail.HTMLBody

    With OutMail

        .To = Variable_To
        .CC = ""
        .BCC = ""
        .Subject = Variable_Subject
        .Attachments.Add (strFileName)
        .HTMLBody = Variable_Body & signature
        .Display                               'or use .Send
        .ReadReceiptRequested = False
    End With
End Sub
 
Last edited:

johankotze

Registered User.
Local time
Today, 03:34
Joined
Jul 3, 2016
Messages
54
Hi Minty I change the code below to

Code:
'Set the ATTACHMENT field
    '--------------------------------------------------------------------------------------
    If Not IsNull(strHyperlink) Then
    OutlookMail.Attachments.Add (strFileName)
    End If

and it is working. Now I need to pretty the email.
 

Minty

AWF VIP
Local time
Today, 01:34
Joined
Jul 26, 2013
Messages
10,374
You are effectively checking the attachment file twice and then adding it twice.
So here you check it
Code:
 ' The filepath for the attachment
    ' ---------------------------------------------------
    If Not IsNull(Me.strHyperlink) Then
    strFileName = Mid$(Me.strHyperlink, InStr(Me.strHyperlink, "#") + 1)
    Else
    strFileName = "Empty"
    End If
Then later on you
Code:
 If Not IsNull(strHyperlink) Then
   OutlookMail.Attachments.Add (strFileName)
   End If
Because strFileName can never be null because of your first check you a now always adding the attachment here.
And then further on
Code:
    .Attachments.Add (strFileName)

You are adding it again. I suspect you can tidy this up and find out which bit of code is really doing the attachment. My guess is the last one. Good luck with the HTML prettiness - I found that a right royal headache :)
 

johankotze

Registered User.
Local time
Today, 03:34
Joined
Jul 3, 2016
Messages
54
Thank for the help thus far. Minty, I tried to check which code is loading the attachment. If I disabled any one of the attachment codes, by putting a quote in front, then the attachment is not add. I guess that is the way to go as it is working. I also use your code for another email that is send from the client's amendments, when amendments is done to his/her policy. Here maximum of 2 attachments can be added. One for the actual amendment (always added) as per email body and the other one if the path exists. Say for instants when a ring valuation certificate has to attached to his/her email. I change the code a bit but only get one attachment added (the one that always will be added). I have difficulty added the strFileName if the strHyperlink exists. Below is the code.

Code:
Private Sub cmdClientAmend_Click()
   'Dim Variable_Note  As String
    Dim stDocName       As String
    Dim MyPath          As String
    Dim MyFilename      As String
    Dim Variable_To     As String
    Dim Variable_CC     As String
    Dim Variable_Subject As String
    Dim Variable_Body   As String
    Dim signature       As String
    Dim OutApp          As Object
    Dim OutMail         As Object
    Dim OutlookAttach   As outlook.Attachment
    Dim strFileName     As String

    'Check if client's email exsists
    '-------------------------------
    If Nz(Me.Text61, "") = "" Then
    MsgBox "Email address required. Go back to database and enter an email address", vbOKOnly + vbCritical, "Email address Required"
    Me.Text61.SetFocus
    Exit Sub
    End If
    
    'I place the file on the network folder
    '-------------------------------------------------------
     MyPath = "\\JKBOffice-HP\Users\JKBOffice\Documents\JKBrokers\Clients\PersonalClients\" & Forms!clientinformation.LastName & " " & Forms!clientinformation.Initials & " " & Forms!clientinformation.Title & "_" & Forms!clientinformation.ClientNr & "\Amendments\"

    'State the filename.
    '-------------------------------------------------------
    MyFilename = "Amendment" & "" & "nr_" & Me.Amendment_nr & " " & Forms!clientinformation.LastName & " " & Forms!clientinformation.Initials & " " & Forms!clientinformation.Title

    'Let's print and save. Once you see it works, you can change True to False so that the file created is not opened after completion.
    '----------------------------------------------------------------------------------------------------------------------------------
    DoCmd.OpenReport "AmendmentPersonalConfirmation", acViewPreview
    DoCmd.OutputTo acOutputReport, "AmendmentPersonalConfirmation", acFormatPDF, MyPath & MyFilename & ".pdf", False

    ' The filepath for the attachment
    '--------------------------------
    If Not IsNull(Me.strHyperlink) Then
    strFileName = Mid$(Me.strHyperlink, InStr(Me.strHyperlink, "#") + 1)
    Else
    strFileName = "Empty"
    End If

    'Let's close our previewed report
    '--------------------------------
    DoCmd.Close acReport, "AmendmentPersonalConfirmation"

    'Set Variables
    '---------------------------
    Variable_To = Me.Text61
    Variable_CC = ""
    Variable_Subject = "BEVESTIGING/CONFIRMATION #" & Me.Amendment_nr & ": " & Me.Text41 & " Polis/Policy#: " & Me.Text32 & "/" & Me.Text36 & " " & Me.Text35 & " " & Me.Text34
    Variable_Body = "<FONT face=Verdana size=2>Geagte/Dear  " & Me.Text103 & "<BR><BR>"
    Variable_Body = Variable_Body & "Die onderstaande wysing(s) is op u polis aangebring/The under mentioned amendment(s) has been done on your policy."
    Variable_Body = Variable_Body & "<hr style= 'color:Black;height:1pt' />"
    Variable_Body = Variable_Body & Me.Amendment
    Variable_Body = Variable_Body & "<hr style= 'color:Black;height:1pt' />"
    Variable_Body = Variable_Body & "<B><U>U ADVISEUR/YOUR ADVISOR:</U></B><BR>" & "Naam/Name: " & Me.Text99 & "<BR>"
    Variable_Body = Variable_Body & "Sel#/Cell#: " & Me.Text101 & "<BR>" & "Epos/Email#: " & Me.Text66 & "<BR>"
    Variable_Body = Variable_Body & "<hr style= 'color:Black;height:1pt' />"
    Variable_Body = Variable_Body & "<Center><B>Op datum skedule word spoedig aan u gepos/Updated schedule will be "
    Variable_Body = Variable_Body & "posted to you soon.</B></Center><BR>"
    Variable_Body = Variable_Body & "Groete/Regards<BR>"
                      
    'Set the ATTACHMENT field
    '--------------------------------------------------------------------------------------
    If Not IsNull(strHyperlink) Then
    OutlookMail.Attachments.Add (strFileName)
    End If

    'Set Outlook session with signature
    '-----------------------------------------------
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail                               ' This creates a blank email and captures the users default signature.
        .BodyFormat = 2                        ' 2 = HTML format
        .Display
    End With

    signature = OutMail.HTMLBody

    With OutMail

        .To = Variable_To
        .CC = Variable_CC
        .BCC = ""
        .Subject = Variable_Subject
        '.Attachment.Add (strFileName)
        .Attachments.Add (MyPath & MyFilename & ".pdf")
        .HTMLBody = Variable_Body & signature
        .Display                               'or use .Send
        .ReadReceiptRequested = False
    End With
    MsgBox "The Email has been send successfully to " & " " & Me.Text36 & " " & Me.Text35 & " " & Me.Text34
End Sub

Minty as per your post #15, I went back and have look again at the attachment code, he code below do add the attachment so I delete the second one
Code:
' The filepath for the attachment
    '--------------------------------
    If Not IsNull(Me.strHyperlink) Then
    strFileName = Mid$(Me.strHyperlink, InStr(Me.strHyperlink, "#") + 1)
    Else
    strFileName = "Empty"
    End If
 
Last edited:

johankotze

Registered User.
Local time
Today, 03:34
Joined
Jul 3, 2016
Messages
54
This threat has been resolved. If I do have any difficulty in future I will post a thread again on this subject. Thanks for Minty an Isskint help on this.:D
 

Minty

AWF VIP
Local time
Today, 01:34
Joined
Jul 26, 2013
Messages
10,374
Glad you have it sorted out. Good luck with the rest of your project.
 

Users who are viewing this thread

Top Bottom