Add default Outlook e-mail signature with Excel without displaying e-mail first

[vanhunk]

[ul]I need a method to send Outlook e-mails from Excel, without having to display the e-mail to retrieve the default signature:[/ul]

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_file s\image001.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]

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]

@Kenneth Hobs
I appreciate your advice. I like your approach.

Regards,
vanhunk

[vanhunk]

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]

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\image001.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]

@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]

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]

@Kenneth Hobs,
Thank you sir, much appreciated!
Regards,
vanhunk