Send Email VBA

[jtodd]

Hi I have the following code ( sent from a colleague to see if i could help)

Private Sub CommandButton1_Click()
    On Error GoTo ErrHandler
   
    ' SET Outlook APPLICATION OBJECT.
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
   
    ' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(olMailItem)

    With objEmail
        .to = "jim.todd@dixonsretail.com"
        .Subject = "This is a test message from Battery Changer"
        '.Body = "Damaged Battery Reported"
        .Body = Range("B11").Value
        .Send        ' SEND MESSAGE.
    End With
   
    ' CLEAR.
    Set objEmail = Nothing:    Set objOutlook = Nothing
       
ErrHandler:
    '
End Sub

this works fine for sendding B11 but he wants to send cells B11 to P11 ,
If i change the range from B11 to B11:P11 it does not even send ?
i have no experience with sending emails from excell so any help would be appreciated .

 

[mumps]

Try this code. I can't take credit for the function as I found it online but I don't remember where to give credit.

Private Sub CommandButton1_Click()
    Dim OutApp As Object, OutMail As Object, rng As Range
    Set rng = Range("B11:P11")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "jim.todd@dixonsretail.com"
        .Subject = "This is a test message from Battery Changer"
        .HTMLBody = RangetoHTML(rng)
        .Display
    End With
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"
    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
    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
    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=")
    TempWB.Close savechanges:=False
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function