• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Create automatic mails including personal excel charts in email body

Erez Shani

New Member
Hi,
I would like to ask your assistant in my complex problem,
I have raw data (say table/xml...) of sales data for different salesperson.
I would like to send a weekly email to each sales person containing a chart with his own personal sales in the following week.
How can i create (automatically) a different charts for each salesperson and automatically email it ?
I appreciate any kind of help you may provide.
Thanks Erez
Erezam@gmail.com
 
Hi,

The below code will create a new outlookmail and attach the selected chart to it.

Still some more information required on to customize the code

1) what type of chart is required
2) what are the details the chart should reflect

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
 
Dear Stanish Kv,
Thanks for your answer.
I've attached the file again, this time with an example for the mail to Chris. (see Sheet "Chris Mail example").
The idea is that each recipient will receive a mail with its own data, according to one email template (the same as in "Chris Mail example" sheet).
 

Attachments

  • database example with mail example.xlsx
    27.2 KB · Views: 10
Hi,

This needs some workings to do which may take some time

The idea is as follows

1) From the database create a pivot with the "name" in rowsource and value
2) By double clicking the value against a name in pivot will create a new sheet with that particular name's details
3) with the active sheet create threee separate charts
4) create a an outlook mail and attach the charts and send to individuals
5)Creating a loop for above steps to repeat till the last name in the piviot

I would require some time to create a macro to achieve the above
 
Hi,

Use the below Code

Note: Incase you want to test the code, change the line ".send" to ".Display" to avoid sending mails directly

Code:
Sub SendwithChart()
 
Application.ScreenUpdating = True
Application.DisplayAlerts = False
 
  Sheets("Data").Select
  ActiveSheet.Cells(1, 1).Select
  ActiveCell.CurrentRegion.Select
  srcdata = ActiveCell.CurrentRegion.Address
  ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
  srcdata).CreatePivotTable TableDestination:="", _
  TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion10
  ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
  ActiveSheet.Cells(3, 1).Select
  ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
  "PivotTable1").PivotFields("name"), "Count of name", xlCount
  With ActiveSheet.PivotTables("PivotTable1").PivotFields("name")
  .Orientation = xlRowField
  .Position = 1
  End With
 
  With ActiveSheet.PivotTables("PivotTable1")
  .ColumnGrand = False
  .RowGrand = False
  End With
 
  ActiveSheet.Name = "Pivot"
 
  Sheets("Pivot").Select
  Range("B5").Select
 
 
 
  Do While ActiveCell.Value <> ""
  Selection.ShowDetail = True
  ActiveSheet.Name = Range("C2").Value
 
  Range("B:B,F:F").Select
  ActiveSheet.Shapes.AddChart.Select
  ActiveChart.ChartType = xlLineMarkersStacked
  ActiveChart.ApplyLayout (9)
 
  Range("B:B,G:G,I:I,K:K").Select
  ActiveSheet.Shapes.AddChart.Select
  ActiveChart.ChartType = xlColumnClustered
  ActiveChart.ApplyLayout (1)
  ActiveChart.ChartTitle.Text = "Sold"
 
 
  Range("B:B,H:H,J:J,L:L").Select
  ActiveSheet.Shapes.AddChart.Select
  ActiveChart.ChartType = xlColumnClustered
  ActiveChart.ApplyLayout (1)
  ActiveChart.ChartTitle.Text = "Revenue"
 
 
  Set mailApp = CreateObject("Outlook.Application")
  Set mail = mailApp.CreateItem(olMailItem)
  mail.display
  Set wEditor = mailApp.ActiveInspector.wordEditor
 
 
  ActiveSheet.ChartObjects("Chart 1").Activate
  ActiveChart.ChartArea.Copy
  wEditor.Application.Selection.Paste
 
  ActiveSheet.ChartObjects("Chart 2").Activate
  ActiveChart.ChartArea.Copy
  wEditor.Application.Selection.Paste
 
  ActiveSheet.ChartObjects("Chart 3").Activate
  ActiveChart.ChartArea.Copy
  wEditor.Application.Selection.Paste
 
 
  With mail
 
  .TO = ActiveSheet.Range("D2").Value
  .Subject = "Test"
  .send
 
  End With
 
 
  ActiveWindow.SelectedSheets.Delete
  Sheets("Pivot").Select
  ActiveCell.Offset(1, 0).Select
 
  Loop
 
  Sheets("Pivot").Select
  ActiveWindow.SelectedSheets.Delete
 
  Application.DisplayAlerts = True
  Application.ScreenUpdating = False
 
End Sub
 
Last edited:
Back
Top