PDA

View Full Version : [SOLVED] Add default Outlook e-mail signature with Excel without displaying e-mail first



vanhunk
05-08-2015, 06:14 AM
I need a method to send Outlook e-mails from Excel, without having to display the e-mail to retrieve the default signature:

I used the method below to achieve this with a custom signature, but could not do it with the default signature.

How can Environ("appdata") be incorporated in the MySignature.htm file?

I used the code be Ron de Bruin and modified it slightly to be able to include a custom signature with a picture. In order for the code to work properly I had to change a line in the MySignature.htm file (found method on the internet, but can’t remember the source).


I had to change the following line in the MySignature.htm file:
<v:imagedata src="MyCompany_files/image001.jpg" o:title=""/>
To:
<v:imagedata src="C:\Users\vanhunk\AppData\Roaming\Microsoft\Signatures\MySignature_files\ima ge001.jpg" o:title=""/>

My aim is to be able for anyone using the workbook to send e-mails to have their own default e-mail signature displayed, without having to display the e-mail in order to get the default signature.

The question is thus how, if at all possible, can I use something like Environ("appdata") instead of C:\Users\vanhunk\AppData\Roaming in the MySignature.htm file?


Thank you very much.

Regards,
vanhunk




Sub Mail_Outlook_With_Signature_Html()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Please visit this website to download the new version.<br>"

SigString = Environ("appdata") & "\Microsoft\Signatures\MySignature.htm"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

On Error Resume Next

With OutMail
.To = "vanhunk@xyz.co.za"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = strbody & "<br>" & Signature
.Send
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub


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

Kenneth Hobs
05-09-2015, 03:10 PM
The thread where I gave you that advice was: http://www.vbaexpress.com/forum/showthread.php?52440

I normally add a comment with the URL to my code when I get code from the internet.

Once you get the text from the HTML file, use Replace() to replace a string. You might want to use Split() to split the file and then InStr() to find which element of the array has the string to modify. After that element is replaced, Join() is used to put it back into a string.

If you attach an example html file, someone can help more easily.

I would recommend obfuscating sensitive data such as e-mails when posting data to the web.

vanhunk
05-11-2015, 01:21 AM
@Kenneth Hobs
I appreciate your advice. I like your approach.

Regards,
vanhunk

vanhunk
05-14-2015, 07:31 AM
The thread where I gave you that advice was: http://www.vbaexpress.com/forum/showthread.php?52440

I normally add a comment with the URL to my code when I get code from the internet.

Once you get the text from the HTML file, use Replace() to replace a string. You might want to use Split() to split the file and then InStr() to find which element of the array has the string to modify. After that element is replaced, Join() is used to put it back into a string.

If you attach an example html file, someone can help more easily.

I would recommend obfuscating sensitive data such as e-mails when posting data to the web.

@Kenneth,
I have attached the contents of the html file as requested.

I have highlighted the line under consideration.

Kind Regards,
vanhunk

Kenneth Hobs
05-14-2015, 12:16 PM
This should get you close. I added an extra function should you want to just replace the first string. I coded it to replace the whole element in the array if the string tag was found.

Don't forget to replace the lines with BCard_files and bcard.htm to suit your paths and filenames.


Sub Mail_Outlook_With_Signature_Html_3()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
Dim img As String, s() As String, i As Long


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
"Please visit this website to download the new version.<br>" & _
"Let me know if you have problems.<br>" & _
"<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
"<br><br><B>Thank you</B>"


'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\bcard.htm"


If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
img = " <v:imagedata src=" & _
Environ("appdata") & "\Microsoft\Signatures\BCard_files\image001.jpg" & _
" o:title=""""/>"
s() = Split(Signature, vbCrLf)
MsgBox UBound(s)
i = IndexInArray("<v:imagedata src=", s()) '-1 = not found. 3rd Parameter is False by default.
'i = IndexInArray("src=", s(), True) '-1 = not found. True means matched to left side of string.
If i <> -1 Then
'Show full array element value in Immediate Window
'for a found string in the first element matched.
'Debug.Print s(i)
s(i) = img
Signature = Join(s, vbCrLf)
End If
Exit Sub
Else
Signature = ""
End If


On Error Resume Next


With OutMail
.to = "kenneth.ray.hobson@gmail.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = strbody & "<br>" & Signature
.Send 'or use .Display
End With


On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub


'If not found, result is -1. Set cm=vbBinaryCompare for exact string comparison.
Function IndexInArray(aValue As String, anArray() As String, _
Optional tfMatchLeft As Boolean = False, Optional cm As Integer = vbTextCompare) As Long
Dim pos As Long, i As Long, ii As Integer
pos = -1
For i = LBound(anArray) To UBound(anArray)
ii = InStr(1, anArray(i), aValue, cm)
If ii <> 0 Then
If tfMatchLeft = True Then
If ii = 1 Then pos = i
Exit For
Else
pos = i
Exit For
End If
End If
Next i
IndexInArray = pos
End Function


Sub Test_ReplaceFirstString()
Dim s As String
s = " <v:imagedata src=""C:\Users\vanhunkh\AppData\Roaming\Microsoft\Signatures\MyCompany_files\imag e001.jpg"" o:title=""""/>"
Debug.Print ReplaceFirstString(s, "ken")
End Sub


Function ReplaceFirstString(aString As String, replaceString As String) As String
Dim s() As String
s() = Split(aString, """")
If UBound(s) >= 1 Then s(1) = replaceString
ReplaceFirstString = Join(s, """")
End Function


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

vanhunk
05-15-2015, 06:40 AM
@Kenneth Hobs,
Thank you very much sir, it seems to be working just fine. I must admit I don't understand what the code is actually doing. Would you mind to add some additional comments, i.e. short descriptions of what the following couple of lines do please?
I do believe this is quite a valuable learning opportunity for many.

Kind Regards,
vanhunk

Kenneth Hobs
05-15-2015, 08:21 AM
I pointed out some things in my commented code.

The value of img is the string that you want to use to replace the first string in the HTM file that has the string, "<v:imagedata src=" in it.

The function IndexInArray() returns the index number of the string array that has the string that was found or not (-1). I normally use WorksheetFunction.Match to search an array but made this routine which seemed to work better and had more versatility. The first parameter is the string to find. The 2nd parameter is the string array to search. The 3rd parameter is optional and set to default value of false, look for string any where in each array element's value. If True, it looks for the string of letters from the left. The 4th and last optional parameter is default value to not be case sensitive. Pass that value as vbBinaryCompare if you want case sensitive searches in the Instr() method. If string is not found, -1 is returned which tells you that no string was found in any of array element's values.

Once you have the index value, you know which element of the string array you are going to replace.

The ReplaceFirstString() function not used in the code but included since I thought it might be of use sometime. It simply replaces the first string delimited by quote marks. It is not fool-proof but could have been used in this sort of task where you might have wanted to keep the prefix or suffix parts of a string for example.

Split() is used to create a string array based on a delimiter like vbCrLF, or a quote mark, or such. Join() is used to create string from an array with a delimiter added between strings which is vbCrLf in this case and the quote marks added back in the unused function.

While in the Visual Basic Editor (VBE), press F1 with cursor in or next to a command word to get help or press F2 and browse for help. Press F8 to execute one line at a time. Once executed, you can move your cursor over variables to get a popup showing the value that it resolved to. I like to use Debug.Print to poke a variable into the Immediate Window or simply MsgBox() as coding tools at each step.

The key to making code is to work on small parts and build the project in a step-wise manner.

vanhunk
05-18-2015, 12:48 AM
@Kenneth Hobs,
Thank you sir, much appreciated!
Regards,
vanhunk