Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
email sending
I am using excel to data log serial data read from COM1, the worksheet its
been filled but I need two things Table estructure Date Time Event 05/19/2007 10:00 Door A Opened 05/19/2007 18:00 Door B Opened 05/20/2007 11:00 Door B Closed 1) each time a new row of data its added to the worksheet a fuction should send and email with this data (its a sms message) 2) a fuction should send a email with all the data of the day theres a cell that will have the date of the last email date sent. Googling I found a fuction using a push botton to send a HTML email with the whole worksheet but don know how to change it to make it do what I need. CODE: Sub CDO_Send_ActiveSheet_Body_Without_Pictures() 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") = "mail.server.com" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Update End With With iMsg Set .Configuration = iConf .To = " .CC = "" .BCC = "" .From = """Edwin"" " .Subject = "This is a test" .HTMLBody = SheetToHTML(ActiveSheet) .Send End With Set iMsg = Nothing Set iConf = Nothing End Sub Public Sub LastCellsWithData() ' ExcelLastCell is what Excel thinks is the last cell Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell) ' Determine the last row with data in it (must also copy above para for this to work) LastRowWithData = ExcelLastCell.Row Row = ExcelLastCell.Row Do While Application.CountA(ActiveSheet.Rows(Row)) = 0 And Row 1 Row = Row - 1 Loop LastRowWithData = Row ' Row number End Sub Public Function SheetToHTML(sh As Worksheet) 'Function from Dick Kusleika his site 'http://www.dicks-clicks.com/excel/sheettohtml.htm 'Changed by Ron de Bruin 19-Aug-2006 Dim TempFile As String Dim Nwb As Workbook Dim fso As Object Dim ts As Object sh.Copy Set Nwb = ActiveWorkbook With Nwb.Sheets(1) On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With 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 On Error Resume Next Kill TempFile fso.deletefolder Left(TempFile, Len(TempFile) - 4) & "*", True On Error GoTo 0 Set ts = Nothing Set fso = Nothing Set Nwb = Nothing End Function |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
email sending
hi,
I think Ron DeBruin has a much simplier approch. check out his site. http://www.rondebruin.nl/sendmail.htm Regards FSt1 "Edwin Martinez" wrote: I am using excel to data log serial data read from COM1, the worksheet its been filled but I need two things Table estructure Date Time Event 05/19/2007 10:00 Door A Opened 05/19/2007 18:00 Door B Opened 05/20/2007 11:00 Door B Closed 1) each time a new row of data its added to the worksheet a fuction should send and email with this data (its a sms message) 2) a fuction should send a email with all the data of the day theres a cell that will have the date of the last email date sent. Googling I found a fuction using a push botton to send a HTML email with the whole worksheet but don know how to change it to make it do what I need. CODE: Sub CDO_Send_ActiveSheet_Body_Without_Pictures() 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") = "mail.server.com" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Update End With With iMsg Set .Configuration = iConf .To = " .CC = "" .BCC = "" .From = """Edwin"" " .Subject = "This is a test" .HTMLBody = SheetToHTML(ActiveSheet) .Send End With Set iMsg = Nothing Set iConf = Nothing End Sub Public Sub LastCellsWithData() ' ExcelLastCell is what Excel thinks is the last cell Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell) ' Determine the last row with data in it (must also copy above para for this to work) LastRowWithData = ExcelLastCell.Row Row = ExcelLastCell.Row Do While Application.CountA(ActiveSheet.Rows(Row)) = 0 And Row 1 Row = Row - 1 Loop LastRowWithData = Row ' Row number End Sub Public Function SheetToHTML(sh As Worksheet) 'Function from Dick Kusleika his site 'http://www.dicks-clicks.com/excel/sheettohtml.htm 'Changed by Ron de Bruin 19-Aug-2006 Dim TempFile As String Dim Nwb As Workbook Dim fso As Object Dim ts As Object sh.Copy Set Nwb = ActiveWorkbook With Nwb.Sheets(1) On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With 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 On Error Resume Next Kill TempFile fso.deletefolder Left(TempFile, Len(TempFile) - 4) & "*", True On Error GoTo 0 Set ts = Nothing Set fso = Nothing Set Nwb = Nothing End Function |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
email sending
Hi Edwin
I also have a example on my site that you can use to send the selection or range. See the Outlook examples http://www.rondebruin.nl/sendmail.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Edwin Martinez" wrote in message ... I am using excel to data log serial data read from COM1, the worksheet its been filled but I need two things Table estructure Date Time Event 05/19/2007 10:00 Door A Opened 05/19/2007 18:00 Door B Opened 05/20/2007 11:00 Door B Closed 1) each time a new row of data its added to the worksheet a fuction should send and email with this data (its a sms message) 2) a fuction should send a email with all the data of the day theres a cell that will have the date of the last email date sent. Googling I found a fuction using a push botton to send a HTML email with the whole worksheet but don know how to change it to make it do what I need. CODE: Sub CDO_Send_ActiveSheet_Body_Without_Pictures() 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") = "mail.server.com" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Update End With With iMsg Set .Configuration = iConf .To = " .CC = "" .BCC = "" .From = """Edwin"" " .Subject = "This is a test" .HTMLBody = SheetToHTML(ActiveSheet) .Send End With Set iMsg = Nothing Set iConf = Nothing End Sub Public Sub LastCellsWithData() ' ExcelLastCell is what Excel thinks is the last cell Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell) ' Determine the last row with data in it (must also copy above para for this to work) LastRowWithData = ExcelLastCell.Row Row = ExcelLastCell.Row Do While Application.CountA(ActiveSheet.Rows(Row)) = 0 And Row 1 Row = Row - 1 Loop LastRowWithData = Row ' Row number End Sub Public Function SheetToHTML(sh As Worksheet) 'Function from Dick Kusleika his site 'http://www.dicks-clicks.com/excel/sheettohtml.htm 'Changed by Ron de Bruin 19-Aug-2006 Dim TempFile As String Dim Nwb As Workbook Dim fso As Object Dim ts As Object sh.Copy Set Nwb = ActiveWorkbook With Nwb.Sheets(1) On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With 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 On Error Resume Next Kill TempFile fso.deletefolder Left(TempFile, Len(TempFile) - 4) & "*", True On Error GoTo 0 Set ts = Nothing Set fso = Nothing Set Nwb = Nothing End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sending a Spreadsheet as an Email Attachment vs. Imbedded in Email | Excel Discussion (Misc queries) | |||
Sending Email | Excel Programming | |||
Email sending | Excel Discussion (Misc queries) | |||
Sending an email | Excel Programming | |||
sending email from Excel | Excel Programming |