Paste data into new email VBA

[nuckfuts]

Hi All -

I'm trying to use the below code (credit: Ron de Bruin) but running into a small problem.

I runs through the entire code and pulls up the email but the email body is blank. I'm using the watches window to view 'RangetoHTML' but once it runs through the replace line the value is still " "

I have the outlook library enabled, is there anything else I could've missed?

Sub Mail_Sheet_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-2016
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set rng = Nothing
    Set rng = ActiveSheet.UsedRange
    'You can also use a sheet name
    'Set rng = Sheets("YourSheet").UsedRange

    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-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

 

[6StringJazzer]

First, this code uses late binding so you do not need a reference to the Outlook library.

The use of ActiveSheet can introduce bugs in some situations. What I would do is set a breakpoint at this line of code:

    Set rng = ActiveSheet.UsedRange

Then when it breaks, go the Immediate Window and type:

print ActiveSheet.Name
print ActiveSheet.UsedRange.Address

And see if the results are what you are expecting. One guess is that the active sheet at this point is not the sheet you think it is.

 

[nuckfuts]

First, this code uses late binding so you do not need a reference to the Outlook library.

The use of ActiveSheet can introduce bugs in some situations. What I would do is set a breakpoint at this line of code:

    Set rng = ActiveSheet.UsedRange

Then when it breaks, go the Immediate Window and type:

print ActiveSheet.Name
print ActiveSheet.UsedRange.Address

And see if the results are what you are expecting. One guess is that the active sheet at this point is not the sheet you think it is.

It's runs as expected - I even had the code as

Set rng = Sheets("Sheet3").UsedRange

The issue is that nothing seems to be getting assigned to RangetoHTML during the function so when it pastes into the email the value is nothing.

 

[6StringJazzer]

If that's the case then the the issue is in Ron's code, but his stuff is generally bulletproof. I would have a hard time diagnosing this without your file. I will see if I can mock up a file and try the same code.

 

[nuckfuts]

The file is basic as I am just testing out the functionality. I've opened a new workbook with random data (=randbetween 0 to 1mm) from B2 to G6 with just the code above in Module 1 and a button on the sheet to execute.

 

[6StringJazzer]

I created a file and used your exact code and it worked perfectly. I just added two Debug.Print statements. So I can't help any further unless you can share a copy of a file that doesn't work.

nuckfuts=rangetoemail.xlsm

Shared with Dropbox

www.dropbox.com

 

[nuckfuts]

I created a file and used your exact code and it worked perfectly. I just added two Debug.Print statements. So I can't help any further unless you can share a copy of a file that doesn't work.

nuckfuts=rangetoemail.xlsm

Shared with Dropbox

www.dropbox.com

I retyped the code again and it works now so I'm really not sure what was going wrong with it initially. Now it picks up (and pastes in the email) anything that seems to be altered. I have empty rows below the data that I have changed the sizing of - the code now picks that up as part of the range that's pasted - is there anyway I can fix this?

 

[6StringJazzer]

Your code uses UsedRange. If you had data, and then just deleted the data in the cells, they are still in UsedRange. Click CTRL-END to see where Excel thinks the end of the UsedRange is. If it includes your empty rows, then select those rows and Delete Rows. After that you may have to close and reopen the file to reset it.

 

[nuckfuts]

Your code uses UsedRange. If you had data, and then just deleted the data in the cells, they are still in UsedRange. Click CTRL-END to see where Excel thinks the end of the UsedRange is. If it includes your empty rows, then select those rows and Delete Rows. After that you may have to close and reopen the file to reset it.

That was it! Also did not know about the CTRL+END function so very helpful, thanks!