Send Email Based on Spreadsheet Criteria

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

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
>
>
>
>
>
>
>

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
>>
>>
>>
>>
>>
>>
>>
>
>

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
> >>
> >>
> >>
> >>
> >>
> >>
> >>
> >
> >
>
>
>

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
>> >>
>> >>
>> >>
>> >>
>> >>
>> >>
>> >>
>> >
>> >
>>
>>
>>

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
> >> >>
> >> >>
> >> >>
> >> >>
> >> >>
> >> >>
> >> >>
> >> >
> >> >
> >>
> >>
> >>
>
>
>

Hi Angus

A chart sheet is not a worksheet
We loop trough the worksheets in the example
> For Each ws In ThisWorkbook.Worksheets

You can do this
> For Each ws In ThisWorkbook.Sheets
But the SheetToHTML is not working with charts and pictures

If you want to send a chart then look at this example
http://www.rondebruin.nl/mail/folder2/chart.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Angus" <[email protected]> wrote in message news:[email protected]...
>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
>> >> >>
>> >> >>
>> >> >>
>> >> >>
>> >> >>
>> >> >>
>> >> >>
>> >> >
>> >> >
>> >>
>> >>
>> >>
>>
>>
>>

My problem is i have a lot of pivot charts to send, so I cannot give a chart
name to export gif. How to amend the code?

"Ron de Bruin" wrote:

> Hi Angus
>
> A chart sheet is not a worksheet
> We loop trough the worksheets in the example
> > For Each ws In ThisWorkbook.Worksheets
>
> You can do this
> > For Each ws In ThisWorkbook.Sheets
> But the SheetToHTML is not working with charts and pictures
>
> If you want to send a chart then look at this example
> http://www.rondebruin.nl/mail/folder2/chart.htm
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
> "Angus" <[email protected]> wrote in message news:[email protected]...
> >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
> >> >> >>
> >> >> >>
> >> >> >>
> >> >> >>
> >> >> >>
> >> >> >>
> >> >> >>
> >> >> >
> >> >> >
> >> >>
> >> >>
> >> >>
> >>
> >>
> >>
>
>
>

lets say i have price quote sheet on my screen- i want to draw lines and
maybe squares on it - then email and maybe save

"WDP" wrote:

> 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
>
>
>
>
>
>
>