Copying from Excel to Outlook - what am I doing wrong?

davidfrommke

New Member
Joined
Sep 16, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hello All -



I am attempting to come up with a macro that will allow me to click a button and move data from the excel spreadsheet and insert into an email.



The problem I have is that when I copy the information from Excel, it formats into the email differently. I would like to keep the same format / picture.



I have copied and pasted the VBA code I am using below.



I also have attachments showing what it looks like in Excel and what I actually get when I get it into Outlook.



Thank you for your help.



Dave



Sub Send_Email()



'Updated by Extendoffice 20200119

Dim xRg As Range

Dim I, J As Long

Dim xAddress As String

Dim xEmailBody As String

Dim xMailOut As Outlook.MailItem

Dim xOutApp As Outlook.Application

On Error Resume Next

xAddress = ActiveWindow.RangeSelection.Address

Set xRg = Application.InputBox("Please select range you need to paste into email body", "KuTools For Excel", xAddress, , , , , 8)

If xRg Is Nothing Then Exit Sub

Application.ScreenUpdating = False

Set xOutApp = CreateObject("Outlook.Application")

Set xMailOut = xOutApp.CreateItem(olMailItem)

For I = 1 To xRg.Rows.Count

For J = 1 To xRg.Columns.Count

xEmailBody = xEmailBody & " " & xRg.Cells(I, J).Value

Next

xEmailBody = xEmailBody & vbNewLine

Next

xEmailBody = "Hi" & vbLf & vbLf & " revised work schedule for following week" & vbLf & vbLf & xEmailBody & vbNewLine

With xMailOut

.Subject = "Revised work schedule for following week"

.To = johnsmith@smith.com

.Body = xEmailBody

.Display

'.Send

End With

Set xMailOut = Nothing

Set xOutApp = Nothing

Application.ScreenUpdating = True



End Sub
Excel Demo - In and Out Sheet - Input.png
Excel Demo - In and Out Sheet - Output.png
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
There are 2 ways of putting the range of cells in an email body with the formatting and layout preserved:

1. Call Ron de Bruin's RangeToHTML function to generate a HTML string containing the formatted cells.

2. Save the cells as a temporary image file and incorporate it in a HTML string with suitable tags.

Either way, the code must assign the HTML string to the Outlook email's HTMLbody property instead of Body. You can add extra text above and below the cells in the email, with appropriate HTML tags.

This macro shows the first method.
VBA Code:
Public Sub Send_Email()

    Dim emailRange As Range
    Dim OutApp As Outlook.Application
    Dim OutEmail As Outlook.MailItem
    Dim HTML As String
    
    Set emailRange = Application.InputBox("Please select the range to paste into the email body.", "Email Work Schedule", _
                                          ActiveWindow.RangeSelection.Address, , , , , 8)
    If emailRange Is Nothing Then Exit Sub
    
    HTML = "<p>Hi,</p><p>Revised work schedule for following week.</p>" & _
           RangeToHTML(emailRange) & _
           "<p>Regards,<br>Name</p>"
     
    Application.ScreenUpdating = False
        
    Set OutApp = New Outlook.Application  'CreateObject("Outlook.Application")
    Set OutEmail = OutApp.CreateItem(olMailItem)
    
    With OutEmail
        .Subject = "Revised work schedule for following week"
        .To = "johnsmith@smith.com"
        .HTMLbody = HTML
        .Display
        '.Send
    End With
    
    Application.ScreenUpdating = True
    
    Set OutEmail = Nothing
    Set OutApp = Nothing

End Sub


'https://www.rondebruin.nl/win/s1/outlook/bmail2.htm
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 paste 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=")

    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

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

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