Deleting Signature In Outlook 2010 message generated via Excel VBA - excel

Question

I have an Excel file where when the user presses a button:
A range is selected and copied to the clipboard
An Outlook message is created based on a template
E-mail will be sent "on behalf of" instead of the user's name/account
The user adds a date in the e-mail and pastes the copied range into the template.
This is all working but Outlook adds the user's signature and that is unwanted.
Sub SelectArea()
Application.ScreenUpdating = False
lastCol = ActiveSheet.Range("a1").End(xlToRight).Column - 2
lastRow = ActiveSheet.Cells(500, lastCol).End(xlUp).Row
ActiveSheet.Range("a1", ActiveSheet.Cells(lastRow, lastCol)).Copy
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate("\\network\path\to\the\MailTemplate.oft")
With OutMail
.SentOnBehalfOfName = """DepartmentX"" <DepartmentX#company.com>"
.Display
End With
Application.ScreenUpdating = True
End Sub
Currently there is no DeleteSig sub. It used to be inside With OutMail. I tested the example from the Microsoft site 1:1 but could not get it to work.
The code from Microsoft:
Sub TestDeleteSig()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem
Set objOL = CreateObject("Outlook.Application")
Set objMsg = objOL.CreateItem(olMailItem)
objMsg.Display
Call DeleteSig(objMsg)
Set objMsg = Nothing
End Sub
Sub DeleteSig(msg As Outlook.MailItem)
Dim objDoc As Word.Document
Dim objBkm As Word.Bookmark
On Error Resume Next
Set objDoc = msg.GetInspector.WordEditor
Set objBkm = objDoc.Bookmarks("_MailAutoSig")
If Not objBkm Is Nothing Then
objBkm.Select
objDoc.Windows(1).Selection.Delete
End If
Set objDoc = Nothing
Set objBkm = Nothing
End Sub
It opens a new e-mail message with signature and gives a compile error.
"User-defined type not defined".
It marks Sub DeleteSig(msg As Outlook.MailItem) in yellow and highlights objDoc As Word.Document in blue.

Answer 1

This will remove the signature from an email template
The last Sub will place a selected range from Excel into the body of the template
Option Explicit
Public Sub TestDeleteSig()
Dim olApp As Object, olMsg As Object
Set olApp = CreateObject("Outlook.Application")
Set olMsg = olApp.CreateItem(0)
olMsg.Display
DeleteSig olMsg
InsertRng olMsg
Set olMsg = Nothing
End Sub
Private Sub DeleteSig(msg As Object)
Dim wrdDoc As Object, wrdBkm As Object
On Error Resume Next
Set wrdDoc = msg.GetInspector.WordEditor
Set wrdBkm = wrdDoc.Bookmarks("_MailAutoSig")
If Not wrdBkm Is Nothing Then wrdBkm.Range.Delete
Set wrdDoc = Nothing
Set wrdBkm = Nothing
End Sub
Private Sub InsertRng(msg As Object)
Dim rng As Range
Set rng = Selection.SpecialCells(xlCellTypeVisible)
If Not rng Is Nothing Then
If rng.Rows.Count = 1 And rng.Columns.Count = 1 Then
If Len(rng) = 0 Then Set rng = ActiveSheet.UsedRange.Cells(1)
End If
rng.Copy
msg.GetInspector.WordEditor.Content.PasteSpecial xlPasteAll
Application.CutCopyMode = False
End If
End Sub
If only one cell is selected and is empty, it will paste the first cell with data from ActiveSheet

Answer 2

So, this is the VBA code that is currently running.
It selects the range, copies it to a blank e-mail, pastes it there and deletes the users' signature.
The "problem" is that it should open a new e-mail based on an existing template (.oft) and paste it where it reads "<insert table/overview>". The oft has an image header and some (html/formatted) text in it.
I'm startin to wonder if what I'm trying to accomplish is even possible.
Sub DeleteSig()
Dim olApp As Object, olMsg As Object
Set olApp = CreateObject("Outlook.Application")
Set olMsg = olApp.CreateItemFromTemplate("\\myserver\my_template.oft")
olMsg.Display
DeleteSig_action olMsg
InsertRng olMsg
Set olMsg = Nothing
End Sub
Sub DeleteSig_action(msg As Object)
Dim wrdDoc As Object, wrdBkm As Object
On Error Resume Next
Set wrdDoc = msg.GetInspector.WordEditor
Set wrdBkm = wrdDoc.Bookmarks("_MailAutoSig")
If Not wrdBkm Is Nothing Then wrdBkm.Range.Delete
Set wrdDoc = Nothing
Set wrdBkm = Nothing
End Sub
Sub InsertRng(msg As Object)
Dim rng As Range
lastCol = ActiveSheet.Range("a1").End(xlToRight).Column - 2
lastRow = ActiveSheet.Cells(500, lastCol).End(xlUp).Row
Set rng = ActiveSheet.Range("a1", ActiveSheet.Cells(lastRow, lastCol))
rng.Copy
msg.GetInspector.WordEditor.Content.PasteSpecial xlPasteAll
Application.CutCopyMode = False
End Sub

Answer 3

Hers is the complete working code which removes signature from the mail template.
Option Explicit
Sub openEmail()
Dim cfgFromEmail As String
Dim cfgNotice As String
Dim cfgTemplate As String
Dim appOutlook As Outlook.Application
Dim newEmail As Outlook.MailItem
Dim rownum As Integer
Dim colnum As Integer
rownum = 6
cfgFromEmail = Sheets("Email").Range("O5").Value
cfgNotice = Sheets("Email").Cells(rownum, 10) '10 = column J
cfgTemplate = Sheets("Email").Cells(rownum, 11) '11 = column K
Set appOutlook = CreateObject("Outlook.Application")
Set newEmail = appOutlook.CreateItemFromTemplate(ThisWorkbook.Path & "\" & cfgTemplate & ".oft")
'Set template = mailApp.CreateItem(olMailItem) 'Creates a blank email
If cfgNotice <> "null" Then 'If is not blank
MsgBox cfgNotice, vbInformation, "Before you send the email"
End If
Dim objDoc As Word.Document
Dim objBkm As Word.Bookmark
On Error Resume Next
Set objDoc = newEmail.GetInspector.WordEditor
Set objBkm = objDoc.Bookmarks("_MailAutoSig")
If Not objBkm Is Nothing Then
objBkm.Select
objDoc.Windows(1).Selection.Delete
End If
Set objDoc = Nothing
Set objBkm = Nothing
With newEmail
.SentOnBehalfOfName = cfgFromEmail
.Display 'Show the email
End With
Set newEmail = Nothing
Set appOutlook = Nothing
End Sub