Insert Lotus Notes Signature In Body Of Email Excel VBA

Hi All,

We are currently using VBA to generate an email in Lotus Notes 8.5.3, and have run into the problem of the auto generated signature appearing before the body text. Forum Guru jaslake has offered much insight, but we havent been able to come up with a solution. An extensive google search also does not reveal a solution, even though this seems to be a pretty universal problem. Ive also had an open ticket with IT at IBM for the last month, but even though their service is very friendly, their concensus seems to be "Let us know when you find a solution".
Any help with this problem would be greatly appreciated!
Here is the current VBA:

Sub LotusMail()
'Control Q as shortcut
' Logic: Display email in Lotus Notes with attachment
' Conditions: Sends to a specific group of recipients,
            ' Subject heading is a static message and yesterdays date or Mondays date if current day is Monday,
            ' Displays static message or an extra message if current day is Friday,
            ' Displays signature

Dim UserName As String ' the current users notes name
Dim MailDbName As String ' the current users notes mail databse name
Dim Recipient As Variant ' allows multiple email addresses to be added in an array
Dim ccRecipient As Variant ' allows multiple email addresses to be added in an array
Dim bccRecipient as Variant ' allows multiple email addresses to be added in an array
Dim Attachment1 As String
Dim Maildb As Object ' the mail database
Dim MailDoc As Object ' the mail document itself
Dim AttachME As Object ' the attachment richtextfile object
Dim Session As Object ' the notes session
Dim EmbedObj1 As Object
Dim stSignature As String
Dim notesUIDoc As Object ' Call workspace.EditDocument(True, MailDoc).GOTOFIELD("Body")

With Application
.ScreenUpdating = False
.DisplayAlerts = False

' Open and locate current LOTUS NOTES User

Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If


' Create New Mail and Address Title Handlers

Set MailDoc = Maildb.CreateDocument

MailDoc.Form = "Memo"

stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("stSignature")(0) ' Gets lotus sig

' Select range of e-mail addresses
Recipient = Array("piercequality@excelforum.com", "piercequality@excelforum.com") 'declares multiple recipients
ccRecipient = Array("piercequality@excelforum.com", "piercequality@excelforum.com") 'declares multiple  CC recipients
bccRecipient = Array("piercequality@excelforum.com", "piercequality@excelforum.com") 'declares multiple BCC recipients
MailDoc.SendTo = Recipient
MailDoc.CopyTo = ccRecipient
MailDoc.BlindCopyTo = bccRecipient


If Weekday(Date, vbMonday) = 1 Then ' If current day is Monday
business_day = Date - 3  ' Then business_day is Friday
Else
business_day = Date - 1 ' If current day is any other day, then business_day is yesterdays date
End If
business_day = (Format(business_day, " DD MMMM "))

MailDoc.subject = "Daily Defects" & business_day ' Displays yesterdays date and Fridays date if Monday

stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("stSignature")(0) ' Gets lotus sig

If Weekday(Date, vbMonday) = 1 Then ' If current day is Monday
Friday_Text = "TGIM"  ' Then "TGIM" will display
Else
Friday_Text = "" ' If current day is any other day, then Fridays Text will not display
End If
MailDoc.body = "Hello World!" & vbCrLf & vbCrLf & Friday_Text & vbCrLf & vbCrLf & stSignature

' Select Workbook to Attach to E-Mail
MailDoc.SaveMessageOnSend = True
Attachment1 = "C:\Users\document.format" '"C:\YourFile.xls" ' Required File Name

If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "Attachment1", "C:\Users\document.format") 'Required File Name
On Error Resume Next
End If


'Displays email message without sending; user needs to click Send
Set workspace = CreateObject("Notes.NotesUIWorkspace")

Set notesUIDoc = workspace.EDITDocument(True, MailDoc)
    
     

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With

errorhandler1:


Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing

    
     
End Sub

Bumping along

Bumping along

Bumping along

Bumping along

Hello jaslake,

I hacked the code from that thread into a fresh document and tossed my email address in it (instead of the range) and although it did send the email though lotus, unfoirtunately there was no signature again. :/
Got me excited for a few minutes lol!

Thanks!