+ Reply to Thread
Results 1 to 3 of 3

Macro to send e-mail through outlook from excel

Hybrid View

  1. #1
    Registered User
    Join Date
    02-09-2013
    Location
    Toronto
    MS-Off Ver
    2010
    Posts
    11

    Macro to send e-mail through outlook from excel

    Hello!

    I have a list of tasks (one task per row) that are assigned to different employees and I would like to be able to send an e-mail directly from the spreadsheet to the assigned person. I would like to be able to add some standard text at the beginning of the e-mail, followed by a table that contains row 1 (headings for columns A through M) and the specific row assigned to that person (columns A through M). The e-mail address of the assigned person is in column N. Is this possible to do through Outlook?

    Thanks!

  2. #2
    Forum Moderator alansidman's Avatar
    Join Date
    02-02-2010
    Location
    Steamboat Springs, CO
    MS-Off Ver
    MS Office 365 insider Version 2505 Win 11
    Posts
    24,755

    Re: Macro to send e-mail through outlook from excel

    See if this helps

    http://www.rondebruin.nl/sendmail.htm
    Alan עַם יִשְׂרָאֵל חַי


    Change an Ugly Report with Power Query
    Database Normalization
    Complete Guide to Power Query
    Man's Mind Stretched to New Dimensions Never Returns to Its Original Form

  3. #3
    Registered User
    Join Date
    02-09-2013
    Location
    Toronto
    MS-Off Ver
    2010
    Posts
    11

    Re: Macro to send e-mail through outlook from excel

    Very helpful thank you! I have used the following code, and would like to make a few changes but am having trouble. I want to send the e-mail to the address which is in the last cell of the selection. Also, I would like the first row (A1:N1) be included in every e-mail without having to highlight it. Is this possible?
    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

+ 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