Vba to copy cells and paste into outlook

thedeadzeds

New member
Joined
Oct 25, 2011
Messages
37
Reaction score
0
Points
0
Excel Version(s)
2016
Hi all,

I have a spreadsheet that I would like to copy and paste information into an email and then send that email to a specific person based on a value that is entered in that cell. Not sure if this is possible but the attached spreadsheet should help explain this. Cell L4 populates with the text 'Urgent' if cell K4 is equal to A4.

When Cell L4 shows 'Urgent', can excel copy cells A4 to Q4 and paste them in an email, and then send it to a specific email address.

The only other thing to consider is that I would want this to work every time Urgent is populated so for example:

When Cell L5 shows 'Urgent', can excel copy cells A5 to Q5 and paste them in an email, and then send it to a specific email address.
When Cell L6 shows 'Urgent', can excel copy cells A6 to Q6 and paste them in an email, and then send it to a specific email address.
When Cell L7 shows 'Urgent', can excel copy cells A7 to Q7 and paste them in an email, and then send it to a specific email address.
AND SO ON.........

Thanks in advance
 

Attachments

  • PPI Assessments - test (2).xls
    28.5 KB · Views: 2,613
Hi there, and welcome to the forum.

Yes, absolutley. A few questions though...
1) How would you like this triggered? Press a button and it sends an email to everyone that is URGENT, or did you want to do it one person at a time?
2) Are you Microsoft Outlook as your email client, or something else?
3) What version of Excel are you using?
4) Where will the email addresses of the person/people to send to be stored? (Hopefully in a column, but which one?)
 
Thaks Vrey much

Yes, absolutley. A few questions though...
1) How would you like this triggered? Press a button and it sends an email to everyone that is URGENT, or did you want to do it one person at a time?

One person at a time

2) Are you Microsoft Outlook as your email client, or something else?

Micorsoft Outlook

3) What version of Excel are you using?

2003
4) Where will the email addresses of the person/people to send to be stored? (Hopefully in a column, but which one?)


Any column is fine as long as its not got anything esle in it

Many thanks for this
 
Okay, try this. Email addresses need to be placed in column Q (although you can easily change that in the code):

Code:
Sub SendEmail()
'Macro Purpose: To send an email through Outlook
    Dim objOL As Object
    Dim objMail As Object
    Dim sEmail As String
    Dim sEmailColumn As String
    Dim sSubject As String
    Dim sBody As String
    Dim lDataRow As Long
    Dim cl As Range
    'Set column with email address
    sEmailColumn = "Q"
    For Each cl In Selection.Resize(, 1)
        'Generate required info
        lDataRow = cl.Row
        'Check if remediation required
        If cl.Parent.Range("L" & lDataRow).Value = "Urgent" Then
            With cl.Parent
                sEmail = .Range(sEmailColumn & lDataRow)
                sSubject = "Agreement " & .Range("B" & lDataRow) & " requires urgent remediation!"
                sBody = "Remediation Required:" & vbNewLine & .Range("H" & lDataRow) & _
                        vbNewLine & vbNewLine & "Advisors Comments:" & vbNewLine & .Range("N" & lDataRow) & _
                        vbNewLine & vbNewLine & "Management Comments:" & vbNewLine & .Range("O" & lDataRow)
            End With
            'Turn on error handling
            On Error GoTo Cleanup
            'Bind to Outlook
            Set objOL = CreateObject("Outlook.Application")
            'Create a new email and send it
            Set objMail = objOL.CreateItem(0)    '0=olmailitem
            With objMail
                .To = sEmail
                .Subject = sSubject
                .Body = sBody
                .Display
            End With
        End If
    Next cl
Cleanup:
    'Release all objects
    Set objMail = Nothing
    Set objOL = Nothing
    On Error GoTo 0
End Sub

Once that code is pasted into a standard module, you can select any cell, press Alt+F8 and run the macro. It should create the email for you. If you select a group of cells, it will create an email for each line where remediation is Urgent.

If you'd like it to send automatically, without creating the preview first, change ".Display" to ".Send"
 
works like a treat.....I cant thank you enough.

Very much appreciated
Thanks
 
Vba to copy cells and paste into outlook

Hi Ken,

Can you please help me with a similar problem? I want to write a code where predefined cells are copied and sent in a mail. Attached in the code which i have written:
Dim objOL As Object
Dim objMail As Object
Dim sEmail As String
Dim sSubject As String
Dim sBody As String
Dim lDataRow As Long
Dim cl As Range
Set b = Range("B2:B100").Find("WHITE", LookIn:=xlValues)
MyRow = b.Row
sSubject = "Test Execution status as of " & Cells(6, 3) & " for " & Cells(7, 3)
sBody = Range("B2:K" & MyRow).Select

'Turn on error handling
On Error GoTo Cleanup
'Bind to Outlook
Set objOL = CreateObject("Outlook.Application")
'Create a new email and send it
Set objMail = objOL.CreateItem(0) '0=olmailitem
With objMail
.Subject = sSubject
.Body = sBody
.Display
End With
Cleanup:
'Release all objects
Set objMail = Nothing
Set objOL = Nothing
On Error GoTo 0
End Sub

Here when i execute the code, "True" is coming in body of mail while i want the copied cells to be in the mail. What should i do to copy my selected range.

Thanks,
Ankit



Okay, try this. Email addresses need to be placed in column Q (although you can easily change that in the code):

Code:
Sub SendEmail()
'Macro Purpose: To send an email through Outlook
    Dim objOL As Object
    Dim objMail As Object
    Dim sEmail As String
    Dim sEmailColumn As String
    Dim sSubject As String
    Dim sBody As String
    Dim lDataRow As Long
    Dim cl As Range
    'Set column with email address
    sEmailColumn = "Q"
    For Each cl In Selection.Resize(, 1)
        'Generate required info
        lDataRow = cl.Row
        'Check if remediation required
        If cl.Parent.Range("L" & lDataRow).Value = "Urgent" Then
            With cl.Parent
                sEmail = .Range(sEmailColumn & lDataRow)
                sSubject = "Agreement " & .Range("B" & lDataRow) & " requires urgent remediation!"
                sBody = "Remediation Required:" & vbNewLine & .Range("H" & lDataRow) & _
                        vbNewLine & vbNewLine & "Advisors Comments:" & vbNewLine & .Range("N" & lDataRow) & _
                        vbNewLine & vbNewLine & "Management Comments:" & vbNewLine & .Range("O" & lDataRow)
            End With
            'Turn on error handling
            On Error GoTo Cleanup
            'Bind to Outlook
            Set objOL = CreateObject("Outlook.Application")
            'Create a new email and send it
            Set objMail = objOL.CreateItem(0)    '0=olmailitem
            With objMail
                .To = sEmail
                .Subject = sSubject
                .Body = sBody
                .Display
            End With
        End If
    Next cl
Cleanup:
    'Release all objects
    Set objMail = Nothing
    Set objOL = Nothing
    On Error GoTo 0
End Sub

Once that code is pasted into a standard module, you can select any cell, press Alt+F8 and run the macro. It should create the email for you. If you select a group of cells, it will create an email for each line where remediation is Urgent.

If you'd like it to send automatically, without creating the preview first, change ".Display" to ".Send"
 
Ken,
I know this thread is pretty old but it references exactly the problem I am trying to solve. Basically I would like to open a new email in Outlook (Outlook will be open already) and then copy in a specified range of cells into the email (ie range("A1:F60")). The cells do not need to be selected beforehand. I do have some merged cells within this range. Any help would be greatly appreciated, thanks!
 
I was able to get this working using another html function as seen below :)

Code:
Function RangetoHTML(rng As Range)
    ' Changed by Ron de Bruin 28-Oct-2006
    ' Working in Office 2000-2010
    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

Dim HyperL As Hyperlink
    For Each HyperL In rng.Hyperlinks
        TempWB.Sheets(1).Hyperlinks.Add _
        Anchor:=TempWB.Sheets(1).Range(HyperL.Range.Address), _
        Address:=HyperL.Address, _
        TextToDisplay:=HyperL.TextToDisplay
    Next HyperL

    '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 xlPublishsource=", _
                          "align=left xlPublishsource=")

    '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
Sub SendEmail()
'Macro Purpose: To send an email through Outlook
    Dim rng As Range
    Dim ToEmailList As String
    Dim CcEmailList As String
    Dim sSubject As String
    
    ToEmailList = "test.com"
    CcEmailList = "Blah.com; haha.com"
    sSubject = "sums"
    
    Set OutApp = GetObject(, "Outlook.Application")
    If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        Set rng = Sheets("Email").Range("A1:F" & ThisWorkbook.Worksheets("Email").UsedRange.Rows.Count)

    With OutMail
        .To = ToEmailList
        .Cc = CcEmailList
        .Subject = sSubject
       .HTMLBody = RangetoHTML(rng)
       .Display
    End With
End Sub
 
Hi Ken,

I appreciate this is old but I was wondering if there was a way to change the original code. We have been using it sucessfully for a year and It works great but in order for the email to be sent, you need to place the mouse on 'urgent' in column L and then run the macro. Is there a way to send the email as soon as the cells reads 'urgent' rather than manually doing it or running any macros manually?

Kind regards
Craig

Code:
Sub SendEmail()
'Macro Purpose: To send an email through Outlook
    Dim objOL As Object
    Dim objMail As Object
    Dim sEmail As String
    Dim sEmailColumn As String
    Dim sSubject As String
    Dim sBody As String
    Dim lDataRow As Long
    Dim cl As Range
    'Set column with email address
    sEmailColumn = "Q"
    For Each cl In Selection.Resize(, 1)
        'Generate required info
        lDataRow = cl.Row
        'Check if remediation required
        If cl.Parent.Range("L" & lDataRow).Value = "Urgent" Then
            With cl.Parent
                sEmail = .Range(sEmailColumn & lDataRow)
                sSubject = "Agreement " & .Range("B" & lDataRow) & " requires urgent remediation!"
                sBody = "Remediation Required:" & vbNewLine & .Range("H" & lDataRow) & _
                        vbNewLine & vbNewLine & "Advisors Comments:" & vbNewLine & .Range("N" & lDataRow) & _
                        vbNewLine & vbNewLine & "Management Comments:" & vbNewLine & .Range("O" & lDataRow)
            End With
            'Turn on error handling
            On Error GoTo Cleanup
            'Bind to Outlook
            Set objOL = CreateObject("Outlook.Application")
            'Create a new email and send it
            Set objMail = objOL.CreateItem(0)    '0=olmailitem
            With objMail
                .To = sEmail
                .Subject = sSubject
                .Body = sBody
                .Display
            End With
        End If
    Next cl
Cleanup:
    'Release all objects
    Set objMail = Nothing
    Set objOL = Nothing
    On Error GoTo 0
End Sub
 
Untested, but... add the following to the worksheet module for whichever sheet you are entering the data on:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Target.Parent.Columns("L:L")) Is Nothing Then
        If LCase(Target.Value) = "urgent" Then Call SendSelectedMailOnly(Target)
    End If
End Sub

Then add the following to a standard module:
Code:
Public Sub SendSelectedMailOnly(cl As Range)
 'Macro Purpose: To send an email through Outlook
 Dim objOL As Object
 Dim objMail As Object
 Dim sEmail As String
 Dim sEmailColumn As String
 Dim sSubject As String
 Dim sBody As String
 'Set column with email address
 sEmailColumn = "Q"
 'Check if remediation required
 With cl.Parent
    sEmail = .Range(sEmailColumn & cl.Row)
    sSubject = "Agreement " & .Range("B" & cl.Row) & " requires urgent remediation!"
    sBody = "Remediation Required:" & vbNewLine & .Range("H" & cl.Row) & _
    vbNewLine & vbNewLine & "Advisors Comments:" & vbNewLine & .Range("N" & cl.Row) & _
    vbNewLine & vbNewLine & "Management Comments:" & vbNewLine & .Range("O" & cl.Row)
 End With
 
 'Turn on error handling
 On Error GoTo Cleanup
 
 'Bind to Outlook
 Set objOL = CreateObject("Outlook.Application")
 
 'Create a new email and send it
 Set objMail = objOL.CreateItem(0) '0=olmailitem
 
 With objMail
    .To = sEmail
    .Subject = sSubject
    .Body = sBody
    .Display
 End With
Cleanup:
 'Release all objects
 Set objMail = Nothing
 Set objOL = Nothing
 On Error GoTo 0

End Sub
HTH,
 
Ken, works like a charm, the only small thing is I get this warning message and have to click yes in order for the email to send. No sure if there is a way around this

'A programme is trying to automatically send email on your behalf. Do you want to allow this? If this is unexpected, it may be a virus and you should choose "No"

untitled.GIF
 

Attachments

  • warning.PNG
    warning.PNG
    10.2 KB · Views: 54
If you're on Office 2003 or earlier, then you pretty much have two options: Buy a copy of Outlook Redemption, and code against that, or download a (free) copy of ClickYes, and use that to click the button for you, as described in this article. If you're on 2007 or later, I thought that issue went away when you have a proper antivirus suite installed...
 
Hi Ken,

this also for what i looking for. let's say in minutes of meeting (let's take it in the same excel file). I would like to having a table show in outlook for those open issue. how should the code be. example when code ran, i will see row 3 (description), and column "c" in open status then it will get the whole row 5 copied into outlook. please advise, thanks.
 
Kamulee, can you upload a workbook with a sample of your data? Then I can make sure it's scoped correctly.
 
Follow on question

ankit, are you still looking for help with this?

Hi Ken,

Thanks for your code. I run into problem with the sBody variable. The end result of what I'd like to do is copy and past Range("A2:A5") and Range("F2:F5") into two separate lines on an email. So far, I've been having trouble copying and pasting anything more than single cell ranges and concatenating them together. Do you have any advice? It would be most appreciated.


Thanks,

Hunter
 
need help to automate excel emai

Dear Ken and members,

Happy new year !

I'm very headache when do my work manually and need to seek a solution for my work, google bring me to here and i think that this forum can save me.
i have a excel file with a lot of information in that, monthly i have to copy the information in this excel file base on staff name and send it to each user email.
can you help me to automate the process by copy all rows of same "card no" number and send it to email of it,
in this example it will send 4 emails with email body is color highlight

1.png
thankyou much in advanced
Con 010707HCM001
 

Attachments

  • Excel Assistan.xlsx
    294 KB · Views: 38
Hello Ken.

I hope you can help. I have never used VBA but thanks to your site, I have learned that I can use VBA to paste data from Excel into an Outlook email. My problem is much like the one that started this thread. I have a spreadsheet that I would like to copy and paste information into an email and then send that email to a specific person whose email address is included in the Excel file.

I'd prefer to send an Outlook template that can be automatically populated with specific cell data. I'd like to be able to manually run the query as needed. I suspect I must create the VBA module in Outlook instead of Excel. Please correct me if I am wrong.

I'd attach a sample of the spreadsheet but I do not see a means of doing so.
 
Last edited:
Back
Top