I amend your code as following, to send the pivot chart with name "chart",
but it doesn't work, why?

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim ws As Worksheet
Dim msg As String
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For Each ws In ThisWorkbook.Worksheets
If InStr(ws.Name, "chart") > 0 Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = ws.Name
.HTMLBody = SheetToHTML(ws)
.Send 'or use .Display
End With
Set OutMail = Nothing
End If
Next ws

"Ron de Bruin" wrote:

> Try the example I posted
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
> "WDP" <[email protected]> wrote in message news:[email protected]...
> > Sorry about that.....Yes....Outlook.....An attachment would be
> > prefered....but if the data was within the body of the email....that would
> > work as well.
> >
> >
> >
> > "Ron de Bruin" wrote:
> >
> >> Hi WDP
> >>
> >> Bed time for me now but here is small example for you to try
> >>
> >> This is a example for Outlook
> >> Copy it all in a normal module
> >>
> >> Change this to your sheet
> >> Set ws1 = Sheets("Sheet1")
> >>
> >> Change this to your range (Use headers in the first row)
> >> Set rng = ws1.Range("A1:C100")
> >> The macro filter on the second column(B)
> >>
> >> '*********************************
> >>
> >> Option Explicit
> >>
> >> Dim ws1 As Worksheet
> >> Dim ws2 As Worksheet
> >> Dim rng As Range
> >> Dim cell As Range
> >> Dim Lrow As Long
> >>
> >> Public Sub Test_With_AdvancedFilter()
> >>
> >> Application.ScreenUpdating = False
> >>
> >> Set ws1 = Sheets("Sheet1")
> >> Set ws2 = Worksheets.Add
> >> Set rng = ws1.Range("A1:C100")
> >> 'Use a Dynamic range name, http://www.contextures.com/xlNames01.html#Dynamic
> >> 'This example filter on the second column (B) in the range (change this if needed)
> >>
> >> With ws1
> >> rng.Columns(2).AdvancedFilter _
> >> Action:=xlFilterCopy, _
> >> CopyToRange:=.Range("IV1"), Unique:=True
> >> 'You see that the last two columns of the worksheet are used to make a Unique list
> >> 'and add the CriteriaRange.(you can't use this macro if you use this columns)
> >> Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
> >> .Range("IU1").Value = .Range("IV1").Value
> >>
> >> For Each cell In .Range("IV2:IV" & Lrow)
> >> .Range("IU2").Value = cell.Value
> >>
> >> ws2.Cells.ClearContents
> >> rng.AdvancedFilter Action:=xlFilterCopy, _
> >> CriteriaRange:=.Range("IU1:IU2"), _
> >> CopyToRange:=ws2.Range("A1"), _
> >> Unique:=False
> >>
> >> .Columns.AutoFit
> >>
> >> ' Run the mail macro
> >> Mail_ActiveSheet_Body
> >>
> >> Next
> >> .Columns("IU:IV").Clear
> >> End With
> >> Application.DisplayAlerts = False
> >> ws2.Delete
> >> Application.DisplayAlerts = True
> >>
> >> Application.ScreenUpdating = True
> >> End Sub
> >>
> >>
> >> Private Sub Mail_ActiveSheet_Body()
> >> Dim OutApp As Object
> >> Dim OutMail As Object
> >> Application.ScreenUpdating = False
> >> Set OutApp = CreateObject("Outlook.Application")
> >> Set OutMail = OutApp.CreateItem(0)
> >> With OutMail
> >> .To = ws2.Range("B2").Value
> >> .CC = ""
> >> .BCC = ""
> >> .Subject = "This is the Subject line"
> >> .HTMLBody = SheetToHTML(ws2)
> >> .display 'or use .Send
> >> End With
> >> Application.ScreenUpdating = True
> >> Set OutMail = Nothing
> >> Set OutApp = Nothing
> >> End Sub
> >>
> >> Public Function SheetToHTML(sh As Worksheet)
> >> 'Function from **** Kusleika his site
> >> 'http://www.*****-clicks.com/excel/sheettohtml.htm
> >> 'Changed by Ron de Bruin 04-Nov-2003
> >> Dim TempFile As String
> >> Dim Nwb As Workbook
> >> Dim myshape As Shape
> >> Dim fso As Object
> >> Dim ts As Object
> >> sh.Copy
> >> Set Nwb = ActiveWorkbook
> >> For Each myshape In Nwb.Sheets(1).Shapes
> >> myshape.Delete
> >> Next
> >> TempFile = Environ$("temp") & "/" & _
> >> Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
> >> Nwb.SaveAs TempFile, xlHtml
> >> Nwb.Close False
> >> Set fso = CreateObject("Scripting.FileSystemObject")
> >> Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
> >> SheetToHTML = ts.ReadAll
> >> ts.Close
> >> Set ts = Nothing
> >> Set fso = Nothing
> >> Set Nwb = Nothing
> >> Kill TempFile
> >> End Function
> >>
> >> '***********************************
> >>
> >>
> >> --
> >> Regards Ron de Bruin
> >> http://www.rondebruin.nl
> >>
> >>
> >> "Ron de Bruin" <[email protected]> wrote in message news:[email protected]...
> >> > Hi
> >> >
> >> > Attachment or Body ?
> >> > Which mail program do you use
> >> >
> >> > --
> >> > Regards Ron de Bruin
> >> > http://www.rondebruin.nl
> >> >
> >> >
> >> > "WDP" <[email protected]> wrote in message news:[email protected]...
> >> >>I have a spreadsheet with data that looks something like the data below. I
> >> >> am looking for a way to automate sending an email to each user (Email Field)
> >> >> with all the rows that include data for that User
> >> >>
> >> >> Date Email Subject
> >> >> 6/27/2005 [email protected] Test4
> >> >> 6/27/2005 [email protected] Test7
> >> >> 6/28/2005 [email protected] Test3
> >> >> 6/28/2005 [email protected] Test6
> >> >> 6/29/2005 [email protected] Test1
> >> >> 6/29/2005 [email protected] Test2
> >> >> 6/29/2005 [email protected] Test5
> >> >>
> >> >> For [email protected] would get an email with the following
> >> >> information
> >> >>
> >> >> Date Email Subject
> >> >> 6/29/2005 [email protected] Test1
> >> >> 6/29/2005 [email protected] Test2
> >> >> 6/28/2005 [email protected] Test3
> >> >> 6/27/2005 [email protected] Test4
> >> >>
> >> >> Any ideas on whether Excel can even do this....and if so, how one would go
> >> >> about making it happen.
> >> >>
> >> >> Thank you
> >> >>
> >> >>
> >> >>
> >> >>
> >> >>
> >> >>
> >> >>
> >> >
> >> >
> >>
> >>
> >>
>
>
>