Hi Steve

Do not change the function
Do what you want in the macro


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


"Steve" <sspatriots@yahoo.com> wrote in message news:1146863892.829944.117540@g10g2000cwb.googlegroups.com...
> Ron,
>
> I've managed to get quite a bit out of this and make it work with a
> small sample spreadsheet, however, for some reason when I try and apply
> what I've made work on a larger scale, the macro wants to create a new
> workbook instead of e-mailing the information in the body of an E-mail.
> Can you have a look at this and tell me why it's doing this?
>
>
> Thanks,
>
> Steve
>
>
> Sub CDO_Send_ActiveSheet_Body()
> Dim iMsg As Object
> Dim iConf As Object
> ' Dim Flds As Variant
>
> Set iMsg = CreateObject("CDO.Message")
> Set iConf = CreateObject("CDO.Configuration")
> iConf.Load -1 ' CDO Source Defaults
> Set Flds = iConf.Fields
> With Flds
>
> .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
>
> .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
> "Fill in your SMTP server here"
>
> .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
> = 25
> .Update
> End With
>
> With iMsg
> Set .Configuration = iConf
> .To = "somebody@yahoo.com"
> .CC = ""
> .BCC = ""
> .From = """Drawing Office"" <myemail@yahoo.com>"
> .Subject = "Status"
> .HTMLBody = SheetToHTML(Sheet2)
> .Send
> End With
>
> Set iMsg = Nothing
> Set iConf = Nothing
> End Sub
>
>
> Public Function SheetToHTML(sh As Worksheet)
>
> Dim TempFile As String
> Dim Nwb As Workbook
> Dim myshape As Shape
> Dim fso As Object
> Dim ts As Object
>
> Selection.AutoFilter Field:=21, Criteria1:= _
> "Do Not Order - Orig Item Not RoHS Compl - Need to Try and Use
> Up"
> Cells.Select
> Selection.Copy
> Sheets("Sheet2").Select
> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> SkipBlanks _
> :=False, Transpose:=False
> Columns("I:L").Select
> Application.CutCopyMode = False
> Selection.NumberFormat = "$#,##0.00"
> Range("A1").Select
> ActiveWindow.SmallScroll ToRight:=9
> Columns("O:Q").Select
> Selection.Delete Shift:=xlToLeft
> Columns("P:AD").Select
> Selection.Delete Shift:=xlToLeft
> Columns("O:O").Select
> Selection.Columns.AutoFit
> Range("A1").Select
>
> Sheets("RoHS Conversion Action List").Select
> Application.CutCopyMode = False
> Selection.AutoFilter
> Range("A1").Select
>
> Sheets("Sheet2").Select
> Range("A1").Select
> Sheets("RoHS Conversion Action List").Select
> Range("A1").Select
>
> 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
>