include signature with Outlook email through Access VBA 1

[MrMode]

I have a form that allows the user to 'create' and add multiple attachments to an email that is then sent through outlook.

It all works with one exception, the signature is dropped from the email, can anyone tell me what to add and where in order to use the users default email signature in outlook?

'Collect the message Subject line and body from the form fields
    Dim MsgSubject
    MsgSubject = Me.Text9
    Dim MsgBody
    MsgBody = Me.Text3
    
'Create the email...
        Dim olApp As Outlook.Application
        Dim olMail As Outlook.MailItem
        Dim objOutlookAttach As Outlook.Attachment
        
        Set olApp = New Outlook.Application
        Set olMail = olApp.CreateItem(olMailItem)

        With olMail
            .BodyFormat = olFormatHTML
            .To = Me.Text11
            .CC = ""
            .Subject = MsgSubject
            .Body = MsgBody
        
            'Add Attachments
            Dim db As DAO.Database
            Dim rstAttachments As DAO.Recordset
                
            'Set db = CurrentDb()
            'Set rstAttachments = db.OpenRecordset("Select TEMPEmailAttachments.FilePath FROM TEMPEmailAttachments;")
            
            If Me.List5.ListCount > 0 Then
            Dim varvalue
                With Me.List5
                For Each varvalue In .ItemsSelected
                    olMail.Attachments.Add (Me.List5.Column(0, varvalue))
                Next
                End With
            End If
            .Save
            .Display    'This allows you to preview the message before sending it.
        '    .Send      'If you want to send without seeing / editing the messages uncomment .Send
        End With

Set olMail = Nothing
Set objOutlookAttach = Nothing

 

[Andrzejek]

You may want to check this link: Add outlook Signature using VBA when sending email, or this one: Insert Outlook Signature in mail. There are a lot of other examples on Google.

Just one other point: your variables are variants:

Dim MsgSubject [red]As Variant[/red]
MsgSubject = Me.Text9
Dim MsgBody [red]As Variant[/red]
MsgBody = Me.Text3

and consider renaming your controls. Text9, Text3, Text11 and List5 are not very descriptive.

Have fun.

---- Andy

There is a great need for a sarcasm font.

 

[MrMode]

Thanks for the suggestions, I have nearly got it working, but it is dropping the MsgBody text and only displaying the signature!

'Collect the message Subject line
    Dim MsgSubject As Variant
    Dim MsgBody As Variant
    
    MsgSubject = Me.Text9
    MsgBody = Me.Text3
    
'Create the email...
        Dim OlApp As Outlook.Application
        Dim olMail As Outlook.MailItem
        Dim objOutlookAttach As Outlook.Attachment
        Dim SigString As String
        Dim signature As String
        
        Set OlApp = New Outlook.Application
        Set olMail = OlApp.CreateItem(olMailItem)
        
        With olMail
            .Display    'This is necessary to collect the default signature as the message must not be modified before collecting it.
        End With
               
        'Change only Mysig.htm to the name of your signature
        SigString = Environ("appdata") & _
                    "\Microsoft\Signatures\Test.htm"
    
        If Dir(SigString) <> "" Then
            signature = GetBoiler(SigString)
        Else
            signature = ""
        End If
    
        On Error Resume Next

        With olMail
            .To = Me.Text11
            .CC = ""
            .Subject = MsgSubject
'            .Body = MsgBody & vbNewLine & signature
            .HTMLBody = MsgBody & vbNewLine & vbNewLine & signature
        
            'Add Attachments
            Dim db As DAO.Database
            Dim rstAttachments As DAO.Recordset
                           
            If Me.List5.ListCount > 0 Then
            Dim varvalue
                With Me.List5
                For Each varvalue In .ItemsSelected
                    olMail.Attachments.Add (Me.List5.Column(0, varvalue))
                Next
                End With
            End If
        '    .Save
            .Display    'This allows you to preview the message before sending it, and stops the automation virus warning.
        '    .Send      'If you want to send without seeing / editing the messages uncomment .Send but you will get virus threat warning from outlook
        End With

Set olMail = Nothing
Set objOutlookAttach = Nothing

And this is the function that collects the signature template

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    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

 

[Andrzejek]

Instead of (what you used to have and still have):
[tt]
Dim MsgSubject As Variant
Dim MsgBody As Variant
[/tt]
I would use[tt]
Dim MsgSubject As [blue]String[/blue]
Dim MsgBody As [blue]String[/blue]
[/tt]
because that's all you need.

but it is dropping the MsgBody text and only displaying the signature!

So this line:
[tt].HTMLBody = MsgBody & vbNewLine & vbNewLine & signature[/tt]
ignores (drops) MsgBody?

So what do you get if you do this:

Debug.Print MsgBody 
.HTMLBody = MsgBody & vbNewLine & vbNewLine & signature
Debug.Print .HTMLBody

This is just a guess on my part, but I suspect your MsgBody is NOT formatted as an HTML text.

Have fun.

---- Andy

There is a great need for a sarcasm font.

 

[MrMode]

Quite right, needed to ensure that the text was formatted as HMTL.

That is brilliant, thanks