 Back to jkp-ads.com |
Ron de Bruin
|
 |
|
Back to jkp-ads.com |
Ron de Bruin
|
|
Ron de Bruin decided to remove all Windows Excel content from his website for personal reasons. If you want to know why, head over to rondebruin.nl.
Luckily, Ron was kind enough to allow me to publish all of his Excel content here.
Most of these pages are slightly outdated and may contain links that don 't work. Please inform me if you find such an error and I'll try to fix it.
Kind regards
Jan Karel Pieterse
Important read this :
The code on this page is only working when you use Outlook as your mail
program.
Copy the code in a Standard module of your workbook, if you just
started with VBA see this page.
Where do I paste
the code that I find on the internet
Check out this Tip page for changing the code on this page.
Tips for changing the code examples
Make a list on the ActiveSheet with :
In column A : Names of the people
In column B
: E-mail addresses
In column C : yes or no ( if the
value is yes it will create a mail)
The Macro will loop through each
row on the Activesheet and if there is a E-mail address in column B and
"yes" in column C it will create a mail with a reminder like the one below
for each person. If you have duplicate addresses in the column check out
this example.
Dear Jelle (Jelle is a name in column A for
example)
Please contact us to discuss bringing your account up to
date
Sub Test1() 'For Tips see: https://jkp-ads.com/rdb/win/winmail/Outlook/tips.htm 'Working in Office 2000-2016 Dim OutApp As Object Dim OutMail As Object Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants) If cell.Value Like "?*@?*.?*" And _ LCase(Cells(cell.Row, "C").Value) = "yes" Then Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = cell.Value .Subject = "Reminder" .Body = "Dear " & Cells(cell.Row, "A").Value _ & vbNewLine & vbNewLine & _ "Please contact us to discuss bringing " & _ "your account up to date" 'You can add files also like this '.Attachments.Add ("C:\test.txt") .Send 'Or use Display End With On Error GoTo 0 Set OutMail = Nothing End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub
Tips
You can also use the values of cells in a range as the body text.
This example will add all the text/values that are in the range G1:G20 to
the body.
Add this code to the sub before the loop start
Dim strbody As String
For Each cell In Range("G1:G20")
strbody = strbody & cell.Value & vbNewLine
Next
And replace the body line with this one
.Body = "Dear " & Cells(cell.Row, "A").Value & vbNewLine & vbNewLine & strbody
If you want to create emails that are formatted you can use HTMLBody (Office 2000 and up) instead of Body. You can find a lot of WebPages on the internet with more HTML tags examples.
.HTMLBody = "<H3><B>Dear " & cell.Offset(0, -1).Value & "</B></H3>" & _
"Please contact us to discuss bringing your account up to date.<BR><BR>" & _
"<B>Regards Ron de Bruin</B>"
Make a list on the ActiveSheet with :
In column A :
Names of the people
In column B : E-mail addresses
In
column C :yes or no ( if the value is yes it will create a
mail)
Note: You can also use a formula in column C
that display yes if a condition is true, this example will display "yes" if
the date in column E is within 90 days of today's date.
=IF((E1-TODAY())>90,"No","Yes")
In
column D :The macro will add "send" in D when you send the
mail
(next time you run the macro it will not mailed again)
In column
E :Date that you want to check with the formula in C to decide if
you want to send the mail
The Macro will loop through each row on the
Activesheet and if there is a E-mail address in column B and "yes" in
column C and not "send" in column D it will create a mail with a reminder
like the one below for each person in the range
Dear
Jelle (Jelle is a name in column A for example)
Please contact us to
discuss bringing your account up to date
Sub Test2() 'For Tips see: https://jkp-ads.com/rdb/win/winmail/Outlook/tips.htm 'Working in Office 2000-2016 Dim OutApp As Object Dim OutMail As Object Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants) If cell.Value Like "?*@?*.?*" And _ LCase(Cells(cell.Row, "C").Value) = "yes" _ And LCase(Cells(cell.Row, "D").Value) <> "send" Then Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = cell.Value .Subject = "Reminder" .Body = "Dear " & Cells(cell.Row, "A").Value _ & vbNewLine & vbNewLine & _ "Please contact us to discuss bringing " & _ "your account up to date." 'You can add files also like this '.Attachments.Add ("C:\test.txt") .Send 'Or use Display End With On Error GoTo 0 Cells(cell.Row, "D").Value = "send" Set OutMail = Nothing End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub
If you want to use the Intellisense help showing you the properties and
methods of the objects as you type you can use Early Binding.
Bit faster also when you run your code but you can have problems when you
distribute your workbooks. Excel will automatic update the reference number
to Outlook when you open your workbook in a higher version of Excel/Outlook
but not update it when you open it in a lower version of Excel/Outlook. With
Late Binding as I used in the macro examples you not have
this problem.
Add a reference to the Microsoft Outlook Library in
Excel
1) Go to the VBA editor with the shortcut
Alt - F11
2) Click on
Tools>References in the Menu bar
3) Place a
Checkmark before Microsoft Outlook ? Object Library
Where ? is the Outlook version number
Then replace
this three lines in the code
Dim OutApp As
Object
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
With this three lines
Dim OutApp As
Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutMail =
OutApp.CreateItem(olMailItem)