Easy Outlook Email Integration

Ken,
This exactly what I have been looking for and it works great!! If you ever decide to work on this some more there are a couple of things that would be helpful:

Get addresses, etc. from specific tab in the workbook
Open up the address lookup so we could navigate to the contact list

Do you know of any customer who's ever satisfied? Doesn't it always go like "That is great but ..." so I completely understand if you accept the kudos and ignore the request.

Thanks again,

Stu

Hey Stu,

Honestly, the purpose of this code was to keep the coding task very simple.

I did just create a solution for a poster based on this though, where we pulled the emails out of a table (you can find that here if you're interested.)

Ken,
Maybe it's just me but I couldn't get an HTML signature without an image to get included at the bottom of the email. I modified your code in the CreateMessage procedure as follows and then it worked:

Code:

        'Add body
        If Len(sSignatureTextPath) > 0 Then
            'Body and plain text signature
            .Body = sBody & vbNewLine & vbNewLine & SignatureText(sSignatureTextPath)

        ElseIf Len(sSignatureHTMLPath) > 0 Then
            'Convert body to HTML and append signature
            '.HTMLBody = ConvertTextToHTML(sBody) & "<br><br>" & sTemp
            .HTMLBody = ConvertTextToHTML(sBody) & "<br><br>" & SignatureText(sSignatureHTMLPath)
        Else
            'Body with no signature
            .Body = sBody
        End If

I did try one signature that had an image and got the "no images allowed" error message. I then changed the signature to my "reply" signature which has all the same text and formatting, but no company logo. When it wouldn't insert into the email (and there was no error) I started debugging the process and determined sTemp had no value. After modifying it to use SignatureText, it worked.

Thanks for the code! I've got a couple of users who are loving the functionality to automate sending tens (if not hundreds) of emails each week. I've got a loop that reads info from rows of data in the spreadsheet and sends an email with a specific attachment for each row with data. The process used to be manual and take 4-8 hrs per week. Now it only takes an hour at most. My last modification will be to let the user decide which signature to use based on the outgoing emails -- some are sent under different program group names so the signature needs to be changed.

Kudos!

Diana

Good day Ken,

Thank you very much for your code. That is very useful! I have customized it a bit. I also experienced that the image used in the HTML signature is not loading. I have fixed it by completing the file path. Below you will find the adjusted code.

- Used function of separate module "File":

Code:

Function FolderPathGet(Path As String) As String
  FolderPathGet = Mid(Path, 1, Len(Path) - Len(Dir(Path)))
End Function

- Class adjustments:

Code:

'Email settings.
Public Const p_c_SignatureName = "IVIT"
Public p_sSignatureName As String
Public p_sSignaturePath As String
Public p_sSignatureFolderFiles As String

Public Property Let AddSignatureHTML(S As String)
  Dim sUser As String
  Dim sPath As String
  Dim sHTML As String
  
  sUser = Environ("USERNAME")
  p_sSignatureName = S
  
  'Look for signature file assuming Windows Vista/7 folder structure.
  sPath = "C:\Users" & sUser & "\AppData\Roaming\Microsoft\Signatures" & p_sSignatureName & ".htm"
  If Dir(sPath) <> vbNullString Then GoTo lblValidPath
  'Test if system is Windows XP or earlier.
  sPath = "C:\Documents and Settings" & sUser & "\Application Data\Microsoft\Signatures" & p_sSignatureName & ".htm"
  If Dir(sPath) <> vbNullString Then GoTo lblValidPath
  'Use default signature.
  p_sSignatureName = p_c_SignatureName
  sPath = "C:\Users" & sUser & "\AppData\Roaming\Microsoft\Signatures" & p_sSignatureName & ".htm"
  If Dir(sPath) <> vbNullString Then GoTo lblValidPath
  sPath = "C:\Documents and Settings" & sUser & "\Application Data\Microsoft\Signatures" & p_sSignatureName & ".htm"
  If Dir(sPath) <> vbNullString Then GoTo lblValidPath
  
  'File can not be located.
  MsgBox "Het e-mailondertekeningsbestand is niet gevonden: " & _
      vbNewLine & sPath, vbOKOnly, "Handtekening niet gevonden"
  
lblValidPath:
  p_sSignaturePath = sPath
  sSignatureHTMLPath = p_sSignaturePath
    
  'Set subfolder name.
  sPath = File.FolderPathGet(p_sSignaturePath) & p_sSignatureName & "_files"
  
  If File.FolderExist(sPath) Then
    p_sSignatureFolderFiles = p_sSignatureName & "_files"
  Else
    sPath = File.FolderPathGet(p_sSignaturePath) & p_sSignatureName & "_bestanden"
    If File.FolderExist(sPath) Then p_sSignatureFolderFiles = p_sSignatureName & "_bestanden"
  End If
  
  'Test if HTML contains an image.
'  If InStr(1, SignatureText(sPath), "<v:imagedata src=") Then
'    MsgBox "Sorry, but I could not use your HTML signature file." & vbNewLine & _
'           "(Unfortunately this routine doesn't handle HTML signatures" & vbNewLine & _
'           "with images.  Please try a plain text signature or an HTML" & vbNewLine & _
'           "signature that does not have any images embedded.", vbOKOnly + vbInformation, _
'           "Signature discarded."
'    Exit Property
'  Else
'    sSignatureHTMLPath = sPath
'  End If
End Property

Private Function SignatureText(ByVal sFile As String) As String
  'Originally written by Dick Kusleika (www.dailydoseofexcel.com)
  'Originally posted at Ron de Bruin's site (www.rondebruin.nl)
  
  'Extracts contents of signature file
  Dim fso As Object
  Dim ts As Object
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
  SignatureText = Replace(ts.readall, p_sSignatureFolderFiles, File.FolderPathGet(p_sSignaturePath) & p_sSignatureFolderFiles)

lblClosure:
  ts.Close
  Set fso = Nothing
  Set ts = Nothing
End Function