Email signature disappears when clipboard contents are added

[jmcconnell]

Hi all, I'm a total novice so looking for a bit of help....

I've got a button within an Excel sheet that basically generates an email with some text in the body and the contents of the clipboard (this is always from using the snipping tool). I just can't seem to get the picture to display below the first couple of lines of text within the email and also, my signature always disappears:

Private Sub Alta1_Click()


Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object


On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
On Error Resume Next

Set OutMail = OutApp.CreateItem(0)

With OutMail
.BodyFormat = 2
.To = ""
.CC = ""
.Subject = "Altahullion 1 fault"
If Time < TimeValue("12:00:00") Then
.Body = "Good Morning," & vbNewLine & vbNewLine & _
"Please see the fault below:"
ElseIf Time > TimeValue("12:00:00") And Time < TimeValue("17:00:00") Then
.Body = "Good Afternoon," & vbNewLine & vbNewLine & _
"Please see the fault below:"
Else
.Body = "Good Evening," & vbNewLine & vbNewLine & _
"Please see the fault below:"


End If

On Error Resume Next



Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range

oRng.collapse 0
oRng.Paste
.Display
End With

Any assistance would be greatly appreciated.
Thanks,
James.

[gmayor]

There are a few provisos to editing the Outlook message body and the first is not to write to the .Body as that wipes out the signature you want to keep. You also need to open Outlook correctly, for which the function identified and linked at the top of the following macro is ideal. Then you can create a message with your signature pasted content and text


Private Sub Alta1_Click()
'Graham Mayor - https://www.gmayor.com - Last updated - 05 Feb 2019
'Requires the code from
'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to start Outlook correctly

Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object

On Error Resume Next
Set OutApp = OutlookApp()

Set OutMail = OutApp.CreateItem(0)

With OutMail
.BodyFormat = 2
.To = ""
.CC = ""
.Subject = "Altahullion 1 fault"

Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)


If Time < TimeValue("12:00:00") Then
oRng.Text = "Good Morning," & vbCr & vbCr & _
"Please see the fault below:"
ElseIf Time > TimeValue("12:00:00") And Time < TimeValue("17:00:00") Then
oRng.Text = "Good Afternoon," & vbCr & vbCr & _
"Please see the fault below:" & vbCr & vbCr
Else
oRng.Text = "Good Evening," & vbNewLine & vbNewLine & _
"Please see the fault below:" & vbCr & vbCr
End If
oRng.collapse 0
oRng.Paste
.Display
End With
Set OutApp = Nothing
Set OutMail = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
End Sub

[jmcconnell]

That's great. Thank you very much for your help. Much appreciated