+ Reply to Thread
Results 1 to 1 of 1

Word Format as Body of mail using Send mail

Hybrid View

  1. #1
    Registered User
    Join Date
    04-19-2012
    Location
    Bangalore,India
    MS-Off Ver
    Excel 2010
    Posts
    5

    Word Format as Body of mail using Send mail

    Hi,

    I am using Ron de Bruin's send mail method to send out a series of mails.

    I have a specially formatted body of mail which is available in Word format, and way for me to select that word file and use that as my Body without losing formatting? Please suggest!

    Here is the code
    Sub Mail_Selection_Range_Outlook_Body()
    ' You need to use this module with the RangetoHTML subroutine.
    ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object
        Dim Worksheet As Worksheet
        
    
        Set rng = Nothing
        On Error Resume Next
        ' Only send the visible cells in the selection.
        Set rng = Sheets("YourSheet").Range("D4:D4").SpecialCells(xlCellTypeVisible)
        ' You can also use a range with the following statement.
        ' Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    
        If rng Is Nothing Then
            MsgBox "The selection is not a range or the sheet is protected. " & _
                   vbNewLine & "Please correct and try again.", vbOKOnly
            Exit Sub
        End If
    
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
    
        Set OutApp = CreateObject("Outlook.Application")
         For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
            If cell.Value Like "?*@?*.?*" Then
    
                Set OutMail = OutApp.CreateItem(0)
                On Error Resume Next
                With OutMail
                   
        
    
        On Error Resume Next
        
             .To = cell.Value
            '.CC = ""
            '.BCC = ""
            
            
    
            .Subject = "This is the Subject line"
            .HTMLBody = RangetoHTML(rng)
            ' In place of the following statement, you can use ".Display" to
            ' display the e-mail message.
            .Display
        End With
        On Error GoTo 0
    
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If
    Next cell
        Set OutMail = Nothing
        Set OutApp = Nothing
           
    End Sub
    
    
    Function RangetoHTML(rng As Range)
    ' Changed by Ron de Bruin 28-Oct-2006
    ' Working in Office 2000-2010
        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
    '**** 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
    Last edited by andy_iyeng; 04-19-2012 at 10:25 AM.

+ Reply to Thread

Thread Information

Users Browsing this Thread

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

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