Results 1 to 8 of 8

Send an email with excel VBA through outlook

Threaded View

Alicita Send an email with excel VBA... 02-08-2011, 10:48 AM
Alicita Re: Send an email with excel... 02-08-2011, 03:48 PM
Alicita Re: Send an email with excel... 02-08-2011, 05:30 PM
Jack in the UK Re: Send an email with excel... 02-08-2011, 06:50 PM
Alicita Re: Send an email with excel... 02-09-2011, 10:42 AM
Alicita Re: Send an email with excel... 02-09-2011, 03:54 PM
trucker10 Re: Send an email with excel... 02-09-2011, 05:36 PM
Alicita Re: Send an email with excel... 02-10-2011, 05:03 PM
  1. #1
    Registered User
    Join Date
    01-09-2011
    Location
    Santiago, Chile
    MS-Off Ver
    Excel 2003
    Posts
    51

    Send an email with excel VBA through outlook

    Hello everyone!

    I'm having some issues with this code: http://www.rondebruin.nl/mail/folder3/mail4.htm

    Sub Mail_Selection_Range_Outlook_Body()
    ' Don't forget to copy the function RangetoHTML in the module.
    ' Working in Office 2000-2010
        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object
    
        Set rng = Nothing
        On Error Resume Next
        'Only the visible cells in the selection
        Set rng = Selection.SpecialCells(xlCellTypeVisible)
        'You can also use a range if you want
        '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")
        Set OutMail = OutApp.CreateItem(0)
    
        On Error Resume Next
        With OutMail
            .To = "ron@debruin.nl"
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .HTMLBody = RangetoHTML(rng)
            .Send   'or use .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)
    ' 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
    It's pretty well explained, but I want to add several ranges to the body of the message.
    .HTMLBody = RangetoHTML(rng)
    I was trying to do something like
    .HTMLBody = RangetoHTML(rng) & RangetoHTML(rng1) & RangetoHTML(rng2)
    Apparently, I can't do that.

    Any help?
    Last edited by Alicita; 02-10-2011 at 05:04 PM. Reason: Entire code added

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