Okay, okay...i was a bit lazy and copped out a bit when i told you to comment if you wanted to see the code for my latest macro, so here it is in all its glory...
Sub Send_Out_Emails()
'
' Send_Out_Emails Macro
' Written by Excel Geek
'
'DEFINE "cel" AS EACH CELL WITHIN THE RANGE DEFINED BELOW
Dim cel As Range
'SET THE RANGE OF EMAILS TO WHICH TO SEND
'YOU MAY WANT TO BE WORKSHEET OR EVEN FILE SPECIFIC IN NAMING THE RANGE,
' DEPENDING UPON HOW YOU USE AND EXECUTE THE MACRO
For Each cel In Range("B2:B201").Cells
'SET THE VALUE OF EACH CELL AS THE "EMAIL_ADDRESS" WHICH YOU'LL SET FOR EACH EMAIL LATER
EMAIL_ADDRESS = cel.Value
'VALIDATE THE EMAIL ADDRESS
'THANK YOU, HENRY (www.azule.info) FOR THIS REGULAR EXPRESSION
Set regEx = CreateObject("VBScript.regexp")
regEx.Global = True
regEx.IgnoreCase = True
regEx.Pattern = "^[a-z0-9\._-]+@+[a-z0-9\._-]+\.+[a-z]{2,4}$"
If regEx.Test(EMAIL_ADDRESS) = False Then
'IF THE EMAIL IS INVALID (="False") THEN I TYPE "invalid email addresss" IN THE CELL JUST RIGHT
cel.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "invalid email address"
ActiveCell.Offset(0, -1).Select
'OTHERWISE, IT'S A VALID EMAIL AND I SEND AN EMAIL TO THE ADDRESS
Else
'CREATE A MAIL ITEM IN OUTLOOK
Set oolApp = CreateObject("Outlook.Application")
Set Email = oolApp.CreateItem(0)
'CREATE A SAFEMAIL ITEM USING OUTLOOK REDEMPTION DLL
Set msg = CreateObject("Redemption.SafeMailItem")
'LOAD THE SAFEMAIL ITEM AS THE MAIL ITEM
msg.Item = Email
'CREATE THE HTML EMAIL BODY
'ALWAYS HAVE THESE FOUR LINES FIRST FOR AN HTML EMAIL
MailBody = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD W3 HTML//EN"">"
MailBody = MailBody & "<HTML>" & vbCrLf
MailBody = MailBody & "<HEAD><TITLE></TITLE></HEAD>"
MailBody = MailBody & "<BODY>" & vbCrLf
'NOTE: IN THE HTML BODY YOU MUST DOUBLE QUOTATION MARKS (LIKE THE ONES AROUND HYPERLINKS, ETC)
' AS VBA WILL THINK YOU'VE ENDED THE LINE OTHERWISE, AS EACH LINE BEGINS AND ENDS (IN VBA)
' WITH OPENING AND CLOSING QUOTATION MARKS
MailBody = MailBody & ""
MailBody = MailBody & ""
'CLOSE THE BODY AND HTML TAGS
MailBody = MailBody & "</BODY></HTML>"
'SET THE EMAIL ADDRESS, SUBJECT LINE, AND HTML BODY (AS WRITTEN ABOVE) TO EACH EMAIL TO SEND
With msg
.to = EMAIL_ADDRESS
' NOTE: BE SURE TO SET THE VALUE OF THE SUBJECT LINE PROPERLY!!!!
.Subject = "This is the subject line of the email"
.HTMLBody = MailBody
.Send
End With
'NOW THAT EMAIL IS SENT, I TIME AND DATE STAMP WHEN EACH IS SENT
' IN THE CELL TWO COLUMNS TO THE RIGHT
cel.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=now()"
ActiveCell.Copy
ActiveCell.PasteSpecial (xlPasteValues)
ActiveCell.Offset(0, -2).Select
End If
'MOVE TO THE NEXT EMAIL ADDRESS IN THE RANGE SPECIFIED
Next
End Sub
No comments:
Post a Comment