Simple email command button request

[WL2005HBD]

Hey guys,

Dumb question, but I'm just trying to find a simple code that will do the following:

On click of a command button, it will copy the text from cell B62, and email it (as body) to a specified email address (the email will not change), with a specified subject (subject will not change).
The only variable is what's in cell B62, other than that, the rest of the values are always the same.

I also do not want it to save the form, email the form as an attachment, or anything else

Any help is appreciated!

Thanks

[nickmax1]

You want to go here:

http://www.rondebruin.nl/win/section1.htm

[WL2005HBD]

Yeah I've tried that site it doesn't help

I need a code that will, on click of button:
1. grab content of cell B62
2. Send it in an email as the body of text to xxx@xxx.com
3. Once sent, go back to the original worksheet. Not save it, not mail it as an attachment.

It needs to have the subject 'BOS/BPS Request' and always send to xxx@xxx.com

Those codes do other weird things

[nickmax1]

Well you must not have read it very clearly, as that page does exactly what you want. I have copied and pasted the code into the sheet for you.

[WL2005HBD]

Which cell is the code copying from?
I can't read VB code on iPhone

[nickmax1]

B62 - like you asked.

[WL2005HBD]

can someone provide be with the VB script, I cannot open the file on Excel 2003?

Thanks

[ugogirl2005]

This is what is in the file. If this works, please give nickmax1 the credit for this answer.

Sub Mail_Selection_Range_Outlook_Body()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2013
    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 fixed range if you want
    Set rng = Sheets("Sheet1").Range("B62").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 = "xxx@xxx.com"
        .CC = ""
        .BCC = ""
        .Subject = "BOS/BPS Request"
        .HTMLBody = RangetoHTML(rng)
        .Display   'or use .Send
    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-2013
    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

[WL2005HBD]

I pasted this under Sub CommabndButton1.Click()

Doesn't work

[ugogirl2005]

Try pasting it in a module then using this code in the sheet (under objects) that the button is on. I didn't copy and paste that part earlier. However, keep in mind if you've renamed the button the sub name does not update and will need to be fixed.

Private Sub CommandButton1_Click()
Call Mail_Selection_Range_Outlook_Body

End Sub

[nickmax1]

as per ugogirl2005, you need to copy and paste the Mail_Selection_Range_Outlook_Body() sub in a new module, and then copy paste the commandbutton1_click() sub in the object of the button.
I am not sure why excel2003 doesnt open up my excel file i uploaded for you as its all there working fine (in my excel 2010)

[WL2005HBD]

Great got it working, thanks guys

Have 2 issues with it though, firstly, it seems in the email it's cutting whatever is in the cell beyond the width of the cell (so for example if the cell really has ABCDEFGH in it, but the width would only allow ABCD to be visible, that's all that shows in the email)
I've gotten around that by obviously expanding the column but it sort of ruins the visual appearance on the sheet. Funny thing is, if I open the email and view it as HTML code I can see the full thing,

Secondly, I had it initially pulling info from cell B62, which had a formula as follows: ="name "&C10" date:"&C14" request: "&C18

It seems the email will only make visible the first line, and translates the &C** as a new paragraph, therefore, not showing in the email (unless you view as HTML code)
I got around that by making the code grab info from several cells

Lastly, it's pulling the formatting exactly as it sees it in Excel, can I make it send an email as plain text?

Thanks

[nickmax1]

Ok....the below should work for you...

Sub Mail_Selection_Range_Outlook_Body()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2013
    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 fixed range if you want
    Set rng = Sheets("Sheet1").Range("B62")
    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 = "xxx@xxx.com"
        .CC = ""
        .BCC = ""
        .Subject = "BOS/BPS Request"
        .HTMLBody = RangetoHTML(rng)
        .Display   'or use .Send
    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-2013
    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 xlValues
        .Cells(1).Select
        
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
        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

[WL2005HBD]

that expanded column B and made ruined the worksheet layout haha

It also cut off everything after the first 8 characters in the email on each line

[nickmax1]

i dont understand, it works perfectly for me. I cannot work with code for such an old version of Excel - I suggest you update to at least 2007.