Macro to Insert Signature in Excel

[Mavericks334]

Hi All,

Below is the macro that i tried to use to insert a range of data and followed by the signature. The Data range is being posted in the mail however the signature does not reflect.

I have tried oOutlookMessage.Display method the signature does reflect once the macro completes the signature disappears. Please help. This macro is for muliple users, it should automatically find their signaute that is y i wrote is as *.htm or *.txt

Sub Send_Range()
'Dimension variables
Dim oOutlookApp As Object, oOutlookMessage As Object
Dim strBody As String
Dim SigString As String
Dim Signature As String
Dim Username As String
Username = Application.Username
'Create an instance of Outlook (or use existing instance if it already exists
Set oOutlookApp = CreateObject("Outlook.Application")
'Create a mail item
Set oOutlookMessage = oOutlookApp.CreateItem(0)

strBody = ConvertRangeToHTML(Sheets("Sheet2").Range("A1:D11"))
strBody = strBody & " "
strBody = strBody & ConvertRangeToHTML(ActiveSheet.Range("B10:N15"))

'Use this to insert your signature
SigString = "C:\Documents and Settings\" & Username & "\Application Data\Microsoft\Signatures\*.txt"
'If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

'Address to send Email with Subject Line
'oOutlookMessage.To = "nk@frk.com"
oOutlookMessage.cc = "rlyke@frk.com"
oOutlookMessage.Subject = "Macro to send email for a range through excel file"
oOutlookMessage.HTMLBody = strBody
oOutlookMessage.Display method
oOutlookMessage.send
'ActiveWorkbook.Save
End Sub
Private Function ConvertRangeToHTML(rngeSend As Range) As String
Dim strHTMLBody As String, strTempFilePath As String
Dim oFSObj As Object, oFSTextStream As Object

'Get the temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")
strTempFilePath = oFSObj.GetSpecialFolder(2)
strTempFilePath = strTempFilePath & "\XLRange.htm"
'Publish the range as HTML
ActiveWorkbook.PublishObjects.Add(4, strTempFilePath, _
rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True

'Open the HTML file using the FilesystemObject into a TextStream object
Set oFSTextStream = oFSObj.OpenTextFile(strTempFilePath, 1)
'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = oFSTextStream.ReadAll
oFSTextStream.Close
'By default the range will be centred. This line left aligns it and you can
'comment it out if you want the range centred.
strHTMLBody = Replace(strHTMLBody, "align=center", "align=left", , , vbTextCompare)
ConvertRangeToHTML = strHTMLBody

'Clean up object variables
Set oFSTextStream = Nothing
Set oFSObj = Nothing

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

 

[ziad alsayed]

please check the below thread

http://www.mrexcel.com/forum/showthread.php?p=2589389#post2589389


i hope it can help.

 

[Mavericks334]

Hi,

Thanks it was helpful. The Problem i am now facing is that my signature is inserted in a single line. Need to insert the signature as follows

Thanks & Regards,
Renato Falcon Lyke,
Analyst - Ops & Tech Administration.​

and also is there a way i could make the code generic, coz this file would be used by muliple people and when they send it their signature need to get captured. I tried .htm so it could find the signature located but it does not work. i get run time error 53 file cannot be found. this is wat i used
igString = "C:\Documents and Settings\" & Username & "\Application Data\Microsoft\Signatures\*.txt"
​

 

[VoG]

Maybe this will help http://www.mrexcel.com/forum/showthread.php?t=372864

 

[Mavericks334]

Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2) this is the section the code stops.

This is the section where the code stops with the error Runtime Error 53 File not found

 

[Mavericks334]

Hi,

I have tried that. It is not working for me. Also i am trying to make my code generic so any one could use it. but it gets stuck here

Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2) this is the section the code stops.

This is the section where the code stops with the error Runtime Error 53 File not found

when i use "C:\Documents and Settings\" & Username & "\Application Data\Microsoft\Signatures\*.txt"

It would be a great help
<!-- / message -->

 

[Mavericks334]

Maybe this will help http://www.mrexcel.com/forum/showthread.php?t=372864

Hi VoG,

I tried it. however it is not working.

Also could please let me know how could i make my code generic. so everyone can use it without altering the code.