E
Edwin Martinez
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 = "(e-mail address removed)"
.CC = ""
.BCC = ""
.From = """Edwin"" <[email protected]>"
.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
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 = "(e-mail address removed)"
.CC = ""
.BCC = ""
.From = """Edwin"" <[email protected]>"
.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