Extract Data to Email Body (from a VBA newbie)

-emma-

Board Regular
Joined
Jul 14, 2006
Messages
162
Hi all,

I have a form that staff complete.

Cells A1:B6 contains information.

I need VBA writing to complete the following:

Send to designated email address
Subject line to be B1 and B2 (example "Mr Smith 12 May 2019")
Copy information from A1:B6 into the body of the email

The user should complete the relevant boxes and hit the "Send Email" button and be presented with a pre populated email where they are just required to press Send.

Any help would be greatly appreciated on this please.

Thanks

Emma
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,070
.
Your UserForm should enter the appropriate information into Sheet1. Then call the macro listed below :


Code:
Option Explicit


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.
' Thanks to Ron DeBruin and Microsoft for their examples  https://www.rondebruin.nl/
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail
    Dim subLine As String
    'Dim RangetoHTML
    Set rng = Nothing
    
    'On Error Resume Next
    
    ' Only send the visible cells in the selection.
    'Set rng = Selection.SpecialCells(xlCellTypeVisible)
    ' You can also use a range with the following statement.
    Set rng = Sheets("Sheet1").Range("A1:B6").SpecialCells(xlCellTypeVisible)
    subLine = Sheets("Sheet1").Range("B1").Value & " " & Sheets("Sheet1").Range("B2").Value


    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 = "To Email Here"
        .CC = ""        '<-- CC Email here
        .BCC = ""       '<-- BCC Email here
        .Subject = subLine
        .HTMLBody = "Dear :  " & "<br><br><br>" & _
                    "Please review this latest data : " & "<br><br>" & _
                    "" & RangetoHTML(rng) & "<br><br><br>" & _
                    "Let us know if we can provide any additional information or assistance." & "<br><br>" & _
                    "Sincerely, " & "<br><br>" & _
                    "John Doe"
            ' In place of the following statement, you can use ".Display" to
            .Display
            '.Send
    End With
    On Error GoTo 0


    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
    Sheets("Sheet1").Range("AA1:AP63").Clear
    Sheets("Sheet1").Range("A1").Select
    
    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 workbook to receive the data.
    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 an .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 the RangetoHTML subroutine.
    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.
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 

-emma-

Board Regular
Joined
Jul 14, 2006
Messages
162
I know how to set up the button and apply the macro, but above that, I'm pretty useless with everything else.

When I run this, I get "Compile error: Expected End Function" and the debug takes me to "Function RangetoHTML(rng As Range)"

Am I doing it wrong? Have I missed something out?

Sorry for my neediness...I did say I was a newbie ;)
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,070
All of the code needs to be pasted into a regular module.

Presently, as the code is written, you would 'hard code' the TO email address into the macro.

The error you are receiving sounds like it is missing END FUNCTION at the very bottom of the macro code.
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,095,232
Messages
5,443,263
Members
405,221
Latest member
danthesuperman

This Week's Hot Topics

  • Copy entire row if CountA <>0 to another sheet
    [B]I want to copy entire row if CountA <>0 for column J7:AM7 (headers on J6:AM6) and so on till the last used cell is column D and paste the...
  • Select last used Row in Table
    I have created a Table in a Worksheet which is locked to prevent user errors and protect formula. Some of the cells require freetext entries which...
  • excel workbook: do not allow certain file name
    Hello all, Don't think this has ever been asked before, but how do I restrict file save [Before_Save Event] if the name of the file being saved...
  • fixing problem autofilter
    hello i need help about my code when i search by code in textbox it doesn't show anything this is my data [ATTACH type="full"...
  • “Weight”
    Hi, i’ve got a long sheet filled with weights such as kg,g,L & ml. i can build a formula to convert kg into g and liter into ml. How ever, my...
  • How to capitalize everything before a certain character?
    In column A, I have some text: Hello good day.mp3 Hello good day.flac etc. I'd like to capitalize everything before the period. I don't need the...
Top