email sending

[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

 

[FSt1]

hi,
I think Ron DeBruin has a much simplier approch. check out his site.
http://www.rondebruin.nl/sendmail.htm

Regards
FSt1

 

[Ron de Bruin]

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