Compile error in email coding

Patriot2879

Well-known Member
Joined
Feb 1, 2018
Messages
1,259
Office Version
  1. 2010
Platform
  1. Windows
Hi, good morning. I have the code below which is just a small part of alot of code for an email, i am trying to add the part in bold to the code infront but i keep on getting a compile error, please can you help? any help is greatly appreciated.

Code:
"<p>" & Me.TextBox3.Value & "</p>" & "[B]<p>" & Worksheets("Northants").Range("A30:J30").End(xlUp).Value & "</p>" & _[/B]
 
hi, thanks for the response back , i am failry new to this i have had a look at the link, but i dont understand what i need to do or where to put it in my code, please can you help? and thank you for your time it is much appreciated.
 
Upvote 0

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
First copy the function from the link I posted to a separate module.

Then change the code to this.
HTML:
Option Explicit

Private Sub CommandButton3_Click()
Dim aOutlook As Object
Dim aEmail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String

    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)

    aEmail.HTMLBody = "<html>******>" & _
                    "<p>Hi All, Please see below todays handover." & Worksheets("Northants").Range("A1").Value & "</p>" & _
                    "<p>" & Me.TextBox7.Value & Me.TextBox9.Value & Me.TextBox8.Value & "</p>" & _
                    "<table border=""1"", cellpadding=""10"", style=background:""#a6bbde"" >" & _
                "<tr>" & _
                    "<th>Replans:</th>" & "<td>" & Worksheets("Northants").Range("B8").Value & "</td>" & "<th>Replans:</th>" & "<td>" & Worksheets("Northants").Range("F8").Value & "</td>" & _
                    "</tr>" & _
                "<tr>" & _
                    "<th>Timeband Slides:</th>" & "<td>" & Worksheets("Northants").Range("B9").Value & "</td>" & "<th>Timeband Extensions:</th>" & "<td>" & Worksheets("Northants").Range("F9").Value & "</td>" & _
                    "</tr>" & _
                "<tr>" & _
                    "<th>Jobs Unscheduled:</th>" & _
                    "<td>" & Worksheets("Northants").Range("B10").Value & "</td>" & _
                    "</tr>" & _
                    "</table>" & _
                "" & _
                "<p>" & Me.TextBox4.Value & "</p>" & _
                "<p>" & Me.TextBox2.Value & "</p>" & _
                "<p>" & Me.TextBox5.Value & "</p>" & _
                "<p>" & Me.TextBox1.Value & "</p>" & _
                "<p>" & Me.TextBox6.Value & "</p>" & _
                "<p>" & Me.TextBox3.Value & "</p>" & RangetoHTML(Worksheets("Northants").Range("A30:J30").End(xlUp)) & _
                "<p>Many Thanks</p>" & _
                "<p>Northants and Bucks Jeopardy Manager</p>" & _
                "</body></html>"
    
    
    aEmail.Recipients.Add (Worksheets("Email Links").Range("A2").Value)
    aEmail.CC = (Worksheets("Email Links").Range("B2").Value)
    aEmail.BCC = ""
    aEmail.Subject = "JM Handover for -  " & Range("E1").Value
    aEmail.Display
       
End Sub
 
Last edited:
Upvote 0
thank you for the resonse back, i have pasted the code in as advised and inserted a new module called module2, i have inpuitted the function code bwlow but i come up with an error. Did i copy the correct section?, thank you again for your time and help on this it is greatly appreciated.

Code:
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"
 
Upvote 0
What error did you get?

Did you copy the entire function?
Code:
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    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
 
Upvote 0
thank you for the response, the email works now but it is still not copying the data from A30:J30 and down :( sorry about this but i am pretty new to this and still understanding and learning. I have copied your code now into Module2 but does any of the wording need to be changed?
 
Upvote 0
Nothing needs to be changed in the code for the function, what might need changed is how you are referring to the range you want to copy into the email.

Can you clarify exactly what range that is?
 
Upvote 0
Hiya thanks for the response back the range is from cells A30 to J30 and then going down to the last data inputted which could for example go down to A100 to J100, hope this makes sense? at the moment it is just copying the data in cell A29. thanks again.
 
Upvote 0
Give this a shot.
HTML:
Option Explicit

Private Sub CommandButton3_Click()
Dim aOutlook As Object
Dim aEmail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
Dim rngDataToEmail As Range

    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)

    With Sheets("Northants")
        Set rngDataToEmail = .Range("A30:J" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
    
    aEmail.HTMLBody = "<html>******>" & _
                    "<p>Hi All, Please see below todays handover." & Worksheets("Northants").Range("A1").Value & "</p>" & _
                    "<p>" & Me.TextBox7.Value & Me.TextBox9.Value & Me.TextBox8.Value & "</p>" & _
                    "<table border=""1"", cellpadding=""10"", style=background:""#a6bbde"" >" & _
                "<tr>" & _
                    "<th>Replans:</th>" & "<td>" & Worksheets("Northants").Range("B8").Value & "</td>" & "<th>Replans:</th>" & "<td>" & Worksheets("Northants").Range("F8").Value & "</td>" & _
                    "</tr>" & _
                "<tr>" & _
                    "<th>Timeband Slides:</th>" & "<td>" & Worksheets("Northants").Range("B9").Value & "</td>" & "<th>Timeband Extensions:</th>" & "<td>" & Worksheets("Northants").Range("F9").Value & "</td>" & _
                    "</tr>" & _
                "<tr>" & _
                    "<th>Jobs Unscheduled:</th>" & _
                    "<td>" & Worksheets("Northants").Range("B10").Value & "</td>" & _
                    "</tr>" & _
                    "</table>" & _
                "" & _
                "<p>" & Me.TextBox4.Value & "</p>" & _
                "<p>" & Me.TextBox2.Value & "</p>" & _
                "<p>" & Me.TextBox5.Value & "</p>" & _
                "<p>" & Me.TextBox1.Value & "</p>" & _
                "<p>" & Me.TextBox6.Value & "</p>" & _
                "<p>" & Me.TextBox3.Value & "</p>" & RangetoHTML(rngDataToEmail) & _
                "<p>Many Thanks</p>" & _
                "<p>Northants and Bucks Jeopardy Manager</p>" & _
                "</body></html>"
    
    
    aEmail.Recipients.Add (Worksheets("Email Links").Range("A2").Value)
    aEmail.CC = (Worksheets("Email Links").Range("B2").Value)
    aEmail.BCC = ""
    aEmail.Subject = "JM Handover for -  " & Range("E1").Value
    aEmail.Display
       
End Sub
 
Upvote 0
thats it that works great please can you explain how you did that please? will that copy all the data down no matter how much i add? this is fantastic i love it :) :)
 
Upvote 0
This is where the range of data to send is set.
Code:
With Sheets("Northants")
        Set rngDataToEmail = .Range("A30:J" & .Range("A" & Rows.Count).End(xlUp).Row)
End With

We start in A30 and then use Range("A" & Rows.Count).End(xlUp).Row to find the last row in column A and append that to get the entire range.
 
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,200
Members
453,022
Latest member
RobertV1609

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top