Automatic Email from Excel

pbt

Well-known Member
Joined
Oct 18, 2005
Messages
1,613
This is a portion of my sheet that I receive help on from Barry Houdini and Tom Urtis for the formulas in columns G:H.
http://www.mrexcel.com/board2/viewtopic.php?t=266549
Birthday 3.xls
ABCDEFGHI
14/7/2007FILTER
2B'DAYYRS-SVCFILTER
3BRANCHNAMEDOBHIREDATEAGEYRS-SVCMESSAGEMESSAGEFILTER
4GSPTOMCLANCEY1/10/19534/4/19815426   
5GSPSIDNEYSHELDON4/20/196110/26/19904516YES 1
6GSPROSEMARYROGERS6/8/19655/9/2001415   
7J-FSPSTEVENKING4/28/19405/4/19956611YESYES1
8J-FSPJUDITHMcNAUGHT10/10/19366/19/2002704   
9J-FSPROSEMARYROGERS3/6/19715/1/19943612 YES1
10L-IWSJOHNGRISHAM8/14/194612/22/19856021   
11L-IWSSCOTTTUROW1/26/19462/14/19876120   
12L-IWSDANIELLESTEEL5/1/19706/27/2004362YES 1
Employees


I am trying to send an email notice with the portion of the filtered list attached so the boss can send his regards to the individual prior to the Birthday or YRS - SVC date.

I have loaded the workbook in the XL Start folder so when Excel is opened this book will also open and the code execute.

If Outlook is open, prior to Excel open, it will send a Draft. If Outlook is closed, prior to Excel open it will send an email. Both are okay.

The problem is, it will send the same email every day (or each time Excel is opened)

What I would like it to do is once the email is sent, it will somehow mark that it has been sent and will not include that particular range in the filter next time the book opens.

That is, in the above example, the book opens and sends email with all info from rows 5, 7, 9, & 12. The next time Excel opens I would not need those rows since the email was already generated, but I would need any new rows that fell within 30 days prior to the dates in "C & D".

This is the code that I am using, found through Search.
Code:
Sub SendRange()
'Sends a specified range in an Outlook message and retains Excel formatting
'**************************
'http://www.danielklann.com
'**************************
'Dimension variables
Dim oOutlookApp As Object, oOutlookMessage As Object
Dim oFSObj As Object, oFSTextStream As Object
Dim rngeSend As Range, strHTMLBody As String, strTempFilePath As String
Dim ws As Worksheet

Set ws = Worksheets("Employees")
Worksheets("Employees").Activate
With ws.Columns("I:I").Select
Selection.AutoFilter Field:=1, Criteria1:="<>"
End With

'Procedure constants
Const lFSO_OPEN_FOR_READING As Long = 1
Const lFSO_TEMP_FOLDER As Long = 2
Const lOUTLOOK_MAILITEM As Long = 0

'Select the range to be sent
On Error Resume Next
Set rngeSend = Worksheets("Employees").Range("A1:H300")
If rngeSend Is Nothing Then Exit Sub 'User pressed Cancel
On Error GoTo 0

'Get the temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")
strTempFilePath = oFSObj.GetSpecialFolder(lFSO_TEMP_FOLDER)
strTempFilePath = strTempFilePath & "\XLRange.htm"


'Now create the HTML file - NOTE! xlSourceRange and xlHtmlStatic have been replaced by their
'numeric values due to a potential error (unexplained) noted by Ivan F Moala 15/5/03
ActiveWorkbook.PublishObjects.Add(4, strTempFilePath, _
rngeSend.Parent.Name, rngeSend.Address, xlSourceWorkbook, "", "").Publish True

'Create an instance of Outlook (or use existing instance if it already exists
Set oOutlookApp = CreateObject("Outlook.Application")

'Create a mail item
Set oOutlookMessage = oOutlookApp.CreateItem(lOUTLOOK_MAILITEM)

'Open the HTML file using the FilesystemObject into a TextStream object
Set oFSTextStream = oFSObj.OpenTextFile(strTempFilePath, lFSO_OPEN_FOR_READING)

'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = oFSTextStream.ReadAll

'By default the range will be centred. This line left aligns it and you can
'comment it out if you want the range centred.
'strHTMLBody = Replace(strHTMLBody, "align=center", "align=left", , , vbTextCompare)

oOutlookMessage.To = "harry@test.com"  '//masked for posting
oOutlookMessage.Subject = "Regards Notice"
oOutlookMessage.HTMLBody = strHTMLBody
'oOutlookMessage.Display
oOutlookMessage.Save
ws.AutoFilterMode = False

'Clean up
oFSTextStream.Close
Set oFSTextStream = Nothing
Set oFSObj = Nothing

Kill strTempFilePath

End Sub

If further explanation is required, let me know.
Thanks
Harry
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Add a Sheet.
Copy the Filtered list to the Sheet [Delete old list if their is one first].
Add a Blank flag value cell to the top of the list.
Then e-mail that sheet [Only if the second cell of the range has a value and the flag cell is Blank!].

This way the code will only e-mail a new list once, and only if it has values.
 
Upvote 0
Thanks for the reply Joe

I'm not sure what you mean by "a Blank flag value"

Harry
 
Upvote 0
It is a Blank Cell that is added to the top of the list. Once you e-mail you add a value to that cell. Your mail code checks to see if that cell is Blank, if it is it mails the list if is Blank it knows that toe list has not been mailed yet!

Think of it as a switch Blank means mail-me, full means do-not-mail-me.
It is a way to make your code smart.
 
Upvote 0
Okay, I think I got it. Could you please take a look if I have coded it correctly or possible, there might be a better way.

This is the sheet now with a new column added so it can be marked as Sent and then filtered on Blanks. Column "J" will filter on Non-Blanks.
Birthday 3.xls
ABCDEFGHIJ
24/9/07B'DAYYRS-SVCSENTx
3BRANCHNAMEDOBHIREDATEAGEYRS-SVCMESSAGEMESSAGEx
4GSPTOMCLANCEY1/10/19534/4/19815426   
5GSPSIDNEYSHELDON4/20/196110/26/19904516YES Y1
6GSPROSEMARYROGERS6/8/19655/9/2001415 YESY1
7J-FSPSTEVENKING4/28/19405/4/19956611YESYESY1
8J-FSPJUDITHMcNAUGHT10/10/19366/19/2002704   
9J-FSPROSEMARYROGERS3/6/19715/1/19943612 YES1
10L-IWSJOHNGRISHAM8/14/194612/22/19856021   
11L-IWSSCOTTTUROW1/26/19462/14/19876120   
12L-IWSDANIELLESTEEL5/1/19706/27/2004362YES 1
Employees


The modified code is this:
Code:
Private Sub Workbook_Open()
'Sends a specified range in an Outlook message and retains Excel formatting
'**************************
'http://www.danielklann.com
'**************************
'Dimension variables
Dim oOutlookApp As Object, oOutlookMessage As Object
Dim oFSObj As Object, oFSTextStream As Object
Dim rngeSend As Range, strHTMLBody As String, strTempFilePath As String
Dim ws1, ws2 As Worksheet

''/////This part added to copy sheet and do two filters  ////////
Set ws1 = Worksheets("Employees")
Set ws2 = Worksheets("Email")

With ws2.Cells.Clear
End With

ws1.Activate
With ws1.Range("A2").Select
    Selection.AutoFilter Field:=9, Criteria1:="="
    Selection.AutoFilter Field:=10, Criteria1:="<>"
With ws1.UsedRange.Copy(Destination:=ws2.Range("A1"))
End With
End With
ws2.Activate
    If ws2.Range("J3") = "" Then
Exit Sub
    End If
''//////////////////////////////////

'Procedure constants
Const lFSO_OPEN_FOR_READING As Long = 1
Const lFSO_TEMP_FOLDER As Long = 2
Const lOUTLOOK_MAILITEM As Long = 0

'Select the range to be sent
On Error Resume Next
Set rngeSend = Worksheets("Email").Range("A1:H300")
If rngeSend Is Nothing Then Exit Sub 'User pressed Cancel
On Error GoTo 0

'Get the temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")
strTempFilePath = oFSObj.GetSpecialFolder(lFSO_TEMP_FOLDER)
strTempFilePath = strTempFilePath & "\XLRange.htm"


'Now create the HTML file - NOTE! xlSourceRange and xlHtmlStatic have been replaced by their
'numeric values due to a potential error (unexplained) noted by Ivan F Moala 15/5/03
ActiveWorkbook.PublishObjects.Add(4, strTempFilePath, _
rngeSend.Parent.Name, rngeSend.Address, xlSourceWorkbook, "", "").Publish True

'Create an instance of Outlook (or use existing instance if it already exists
Set oOutlookApp = CreateObject("Outlook.Application")

'Create a mail item
Set oOutlookMessage = oOutlookApp.CreateItem(lOUTLOOK_MAILITEM)

'Open the HTML file using the FilesystemObject into a TextStream object
Set oFSTextStream = oFSObj.OpenTextFile(strTempFilePath, lFSO_OPEN_FOR_READING)

'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = oFSTextStream.ReadAll

'By default the range will be centred. This line left aligns it and you can
'comment it out if you want the range centred.
'strHTMLBody = Replace(strHTMLBody, "align=center", "align=left", , , vbTextCompare)

oOutlookMessage.to = "harry@test.com"  '//masked for posting
oOutlookMessage.Subject = "Regards Notice"
oOutlookMessage.HTMLBody = strHTMLBody
'oOutlookMessage.Display
oOutlookMessage.Save
ws1.AutoFilterMode = False


'Clean up
oFSTextStream.Close
Set oFSTextStream = Nothing
Set oFSObj = Nothing

Kill strTempFilePath
Application.ActiveWorkbook.Save
'Application.ActiveWorkbook.Close

End Sub

Thanks
Harry
 
Upvote 0
The question is does it work for you?
Are you happy with it?
Do you wish it did something else?
 
Upvote 0
The way it is right now, works Okay

What I was after was (is)
I have loaded the workbook in the XL Start folder so when Excel is opened this book will also open and the code execute.
That is, in the above example, the book opens and sends email with all info from rows 5, 7, 9, & 12. The next time Excel opens I would not need those rows since the email was already generated, but I would need any new rows that fell within 30 days prior to the dates in "C & D".

I wanted this to be automatic so when the code completed, the Book would close. (commented out last line)

I couldn't figure out a "Flag cell" so I inserted another column that would have to be manually inputted so it will filter out the ones that were sent. And somehow I will have to delete anything that is typed in this column so it will work for the next year.

If you look at the sheet on the very first post and the sheet on the post above, you will notice that row 5 would have been a new email to send if on Saturday rows 5, 7, 9, & 12 was already sent.

So, this is where I couldn't figure out a how to make a single cell a "flag" without flagging all rows that had met the IF formula in "J" =IF(G4="YES",1,IF(H4="YES",1,""))

I may be asking too much of Excel and Outlook to work together. ? ?
It is highly possible that I am not looking at this in the proper way. Still trying to learn.

Harry
 
Upvote 0
BUMP

I still need help on the last post, in particular the quoted part.

Anybody know how to do this.

Thanks
Harry
 
Upvote 0
"So, this is where I couldn't figure out a how to make a single cell a "flag" without flagging all rows that had met the IF formula in "J" =IF(G4="YES",1,IF(H4="YES",1,"")) "


This is working code, but I did not use your Ranges and tests, [Look at the cells in the range, if all the cells are blank in that range then add an "X" to cell: A1 only!] use this as a model:

Set myRng = Sheets("Sheet1").Range("H6:H12")

For Each cell In myRng
If cell.Value <> "" Then myFlag = True
Next cell

If myFlag <> True Then Sheets("Sheet1").Range("A1").Value = "X"
 
Upvote 0

Forum statistics

Threads
1,215,334
Messages
6,124,319
Members
449,153
Latest member
JazzSingerNL

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top