Vba to copy cells and paste into outlook

Hi MrT,

If you're pushing the data from Excel, I'd probably use Excel, not Outlook to host the code. We can use VBA's SaveCopyAs method to make a copy of the active workbook so we can attach it. Or we can push a range from Excel into an email as well. My recommendation would be to start a new thread that outlines what you want to do. (More visibility than tacking on an old one.)

Oh, and sample workbooks can be attached via the advanced posting interface. (Click Go Advanced at the bottom.)
 
SendSelectedCellsAsReplyAll_inOutlookEmail

Hi Ken,

I need your help that is similar to the original thread code.

Here is my problem, I want the selected cell to be left indent and the text(cell) format as per my email body format (ie font, color, size).

As for your information, the cell I wanted to select is in the middle of the table as shown in below picture.

VBA Selected Cell Column.JPG

And I want my end result to be like this.

VBA desired outcome.PNG

Problem is, when this code run, below is the outcome I received.

VBA Current Outcome.JPG

I am very new to excel VBA and I am using Microsoft Outlook and Excel Version 2010.

Below is my code and I hope you could help me.

Code: 
Sub SendSelectedCellsAsReplyAll_inOutlookEmail()
    Dim objSelection As Excel.Range
    Dim objTempWorkbook As Excel.Workbook
    Dim objTempWorksheet As Excel.Worksheet
    Dim strTempHTMLFile As String
    Dim objTempHTMLFile As Object
    Dim objFileSystem As Object
    Dim objTextStream As Object
    Dim objOutlookApp As Outlook.Application
    Dim objNewEmail As Outlook.MailItem
    Dim xOutMsg As String
            
    Dim mail 'object/mail item iterator
    Dim replyAll 'object which will represent the reply email
 
    'Copy the selection
    Set objSelection = Selection
    Selection.Copy
 
    'Paste the copied selected ranges into a temp worksheet
    Set objTempWorkbook = Excel.Application.Workbooks.Add(1)
    Set objTempWorksheet = objTempWorkbook.Sheets(1)
 
    'Paste the selection
    With objTempWorksheet.Cells(1)
    Set objSelection = Selection
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteColumnWidths
        
    End With
 
    'Save the temp worksheet as a HTML file
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    strTempHTMLFile = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Excel" & Format(Now, "YYYY-MM-DD hh-mm-ss") & ".htm"
    Set objTempHTMLFile = objTempWorkbook.PublishObjects.Add(xlSourceRange, strTempHTMLFile, objTempWorksheet.Name, objTempWorksheet.UsedRange.Address)
    objTempHTMLFile.Publish (True)
 
    'Create a new email
    Set objOutlookApp = CreateObject("Outlook.Application")
    Set objNewEmail = objOutlookApp.CreateItem(olMailItem)
 
    'Read the HTML file data and insert into the email body
    Set objTextStream = objFileSystem.OpenTextFile(strTempHTMLFile)
    
    'replyAll
    For Each mail In Outlook.Application.ActiveExplorer.Selection
    If mail.Class = olMail Then
        Set replyAll = mail.replyAll
        With replyAll
            'Set body format to HTML
             .HTMLBody = objTextStream.readall & vbCrLf & replyAll.HTMLBody
             xOutMsg = "<span style=""color:#1F497D"">Hi</span style=""color:#1F497D""><br />" & _
                       "<p style='font-family:calibri;font-size:11pt'></p>"
              .HTMLBody = xOutMsg & vbCrLf & replyAll.HTMLBody
             .Display
        End With
    End If
    Next
    
    objTextStream.Close
    objTempWorkbook.Close (False)
    objFileSystem.DeleteFile (strTempHTMLFile)
    
End Sub
 
You must log in or register to reply here.
Back
Top