+ Reply to Thread
Results 1 to 2 of 2

Excel ws into outlook html body with current html signature

  1. #1
    Registered User
    Join Date
    01-28-2014
    Location
    Merseyside, England
    MS-Off Ver
    Excel 2007
    Posts
    4

    Excel ws into outlook html body with current html signature

    Hi Everyone,

    So i realise its a reoccuring problem to populate an email with VBA but I'm fine with that aspect of things.
    I'm also fine with inserting a HTML signature into outlook from Excel.

    But!!! I need to combine a worksheet into the body of an Email with my default signature.

    I've tried to merge Ron de Bruin's two subs referencing this and have got it to populate the Email with my body text and the worksheet. But no matter how i phrase the sub i can't get the signature to work aswell.

    Any help you can give would be appreciated.

    Cade

  2. #2
    Registered User
    Join Date
    01-28-2014
    Location
    Merseyside, England
    MS-Off Ver
    Excel 2007
    Posts
    4

    Re: Excel ws into outlook html body with current html signature

    This is my current code. Again any help would be appreciated:

    Sub Email_Sheet()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim StrBody As String
    Dim StrBody2 As String
    Dim SigString As String
    Dim signature As String
    Dim FileNameHTMSig As String

    StrBody = "Hi," & "<br><br>" & _
    "Please could we order" & "<br>"

    StrBody2 = "Thanks," & "<br><br><br>"

    SigString = "c:\user\" & Environ("username") & _
    "\appdata\Microsoft\Signatures"

    FileNameHTMSig = Dir$(DirSig & "\*.htm")

    If Dir(SigString) <> "" Then
    signature = GetBoiler(SigString & "\" & FileNameHTMSig)
    Else
    signature = ""
    End If

    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With

    Set rng = Nothing
    Set rng = ActiveSheet.UsedRange

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

    On Error Resume Next
    With OMail
    .Display
    End With

    With OutMail
    .To = "****"
    .Subject = "****"
    .HTMLBody = StrBody & RangetoHTML(rng) & "<Br>" & StrBody2 & "<br>" & signature
    .Display
    End With
    On Error GoTo 0

    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    End Sub


    Function RangetoHTML(rng As Range)

    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
    SourceType:=xlSourceRange, _
    Filename:=TempFile, _
    Sheet:=TempWB.Sheets(1).Name, _
    Source:=TempWB.Sheets(1).UsedRange.Address, _
    HtmlType:=xlHtmlStatic)
    .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
    "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = 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

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Problem with copying charts into html body outlook
    By katekatebobs in forum Excel Programming / VBA / Macros
    Replies: 19
    Last Post: 12-13-2013, 02:16 PM
  2. Excel Macro to resize the HTML Body
    By Jovillanueva in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 12-12-2013, 01:46 AM
  3. Send e-mail with image on body (.html) on e-mail manager <> outlook
    By mariotnc in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 11-05-2012, 09:28 PM
  4. Automate Lotus Notes email with HTML body from excel
    By wotadude in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 08-25-2010, 06:47 PM
  5. Excel macro to send HTML Body email
    By Benjamin2008 in forum Excel General
    Replies: 1
    Last Post: 05-01-2010, 05:29 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1