Modify my code to copy ranges to email

michibahn · May 13th 2015

Hi Guys,

I have the code below to email the results of whatever data is on A3 and B3 if I typed "Y" in M3. It will open up an email body using the Subject line on M2 and using the email address on M1

I'm planning to add a chart which I will place somewhere in A20 as part of the email. I realized it will be easier for me if the code will just copy whatever is on column A upto J and rows 1 to 100 including charts, pictures etc...

Is this doable? Thanks in advance!

Code

Private Sub Worksheet_Change(ByVal Target As Range)Dim tRow As Integer
Dim i As Integer
If Target.Column >= 17 Or Target.Column <= 12 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Target = "Y" Or Target = "y" Then








tRow = Target.Row
i = Target.Column








Dim temp As String
Dim ws As Worksheet
Dim rowNr As Integer
Dim strTo As String
Dim Acc As String








strTo = ""








Set ws = ActiveSheet
rowNr = tRow








 If ws.Cells(rowNr, i).Value = "Y" Or ws.Cells(rowNr, i).Value = "y" Then
        temp = ws.Cells(2, i).Value
        strTo = ws.Cells(1, i).Value
        Acc = ws.Cells(rowNr, 1).Value
        BCC = ws.Cells(rowNr, 2).Value
                  




'Declare and establish the Object variables for Outlook.
Dim objOutlook As Object
Dim objNameSpace As Object
Dim objInbox As Object
Dim objMailItem As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNameSpace.Folders(1)
Set objMailItem = objOutlook.CreateItem(0)
        




'Display the email message
With objMailItem
.to = strTo
.Subject = temp
.Body = "**** Summary of Study ****" & Chr(10) & vbLf & _
"No. of Subjects Dosed = " & Acc & Chr(10) & _
"No. of Failures = " & BCC & Chr(10) & vbLf & _
"**** End of Summary ****" & Chr(10) & vbLf & _
"Thank You!" & Chr(10) & _
"BioPharma Services Inc." & Chr(10) & _
"4000 Weston Rd." & Chr(10) & _
"Toronto, Ontario M9L 3A2" & Chr(10) & _
"www.biopharmaservices.com"




    
'Change to .Send if you want to just send it.
.Display
End With








'Release object variables from system memory.
Set objOutlook = Nothing
Set objNameSpace = Nothing
Set objInbox = Nothing
Set objMailItem = Nothing








End If
End If
End Sub

Display More

ashu1990 · May 14th 2015

Re: Modify my code to copy ranges to email

this codes copy charts into email body, hope you will be able to ammend it into yours for your better learning.

Code

Sub CopyAndPasteToMailBody()
    Set mailApp = CreateObject("Outlook.Application")
    Set mail = mailApp.CreateItem(olMailItem)
    mail.Display
    Set wEditor = mailApp.ActiveInspector.wordEditor
    ActiveChart.ChartArea.Copy
    wEditor.Application.Selection.Paste
End Sub

michibahn · May 14th 2015

Re: Modify my code to copy ranges to email

Quote from ashu1990;745975

this codes copy charts into email body, hope you will be able to ammend it into yours for your better learning.

Code

Sub CopyAndPasteToMailBody()
    Set mailApp = CreateObject("Outlook.Application")
    Set mail = mailApp.CreateItem(olMailItem)
    mail.Display
    Set wEditor = mailApp.ActiveInspector.wordEditor
    ActiveChart.ChartArea.Copy
    wEditor.Application.Selection.Paste
End Sub

thanks ashu... I have actually tried that but unfortunately if I insert it to my existing code, it opens up 2 new emails.. 1 for my original code and 1 for the chart i'm really not good in VBA and i'm hoping someone can help me out..

Modify my code to copy ranges to email

Participate now!

Share