Sending html email from VBA email program - html

I have written an email program for my organization the handles some very specialized things very well, things I could use Outlook or Gmail for. Now, the manager would like to send an occasional email to our small customer base, but I want the email body tto look professional and not send it as an attachment. I have cobbled together an html document that present in all browsers and has been validated. My problem is I can't figure out how to point the message body at the html document. Here is the salient code.
This is where all is set up:
Do While mailRs.EOF = False
'Me.AttachDoc = "C:\EmailFolder\CouponForm.pdf"
emTo = mailRs.Fields("EmailAddr").Value
emFrom = "SportsParkInfo#skokieparks.org"
emSubject = Me.Subject
emtextBody = Me.TextMessage
Here is a the call for sending the email
Call SendAMessage(emFrom, mailRs.Fields("EmailAddr").Value, _
emSubject, emtextBody, emAttach)
(I got the code for sending the email off the web and it works great through our mail server.)
In the above, before the call # emtextBody = Me.TextMessage is where I need to replace Me.TextMessage with the address/body of the html document. And the message box is a textBox on the ACCESS form. I can't find any control in ACCESS that takes html. I can't use the path to the html document because that generates an error. Is there a way of getting around this
If more information is required I'll be happy to supply it.
Thanks for your time.
jpl

Use something like the below code. I've included elements for attachment as well as html formatting but pretty much anything you can write in html can also be done within vba.
Sub SharePerformance()
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.createitem(0)
'& "\\server\folder" &
msg1 = "Team,<br><br><b><DL>" & Range("b5").Value & "</b><br><ul><b><u>" & Range("b6").Value & "</b></u>"
msg1 = msg1 & "<DT><a HREF=C:\USER\Desktop\File1.xlsb>"
msg1 = msg1 & Range("b7").Value & "</a><br>"
msg1 = msg1 & "<b><u>" & Range("b9").Value & "</b></u></DL><br><br>"
msg1 = msg1 & "<p><img src=file://" & "C:\temp\Chart1.png" & "></p>" & "<br>"
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = Range("B1").Value
.cc = ""
.BCC = ""
.Subject = Range("B3").Value
.HTMLBody = msg1
'.Attachments.Add ActiveWorkbook.FullName
'.Attachments.Add ("C:\temp\Chart1.png")
'.Attachments.Add ("C:\temp\Chart2.png")
.display
End With
SendKeys "^{ENTER}"
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

I can't tell what code is inside that SendAMessage function you are using but all the VBA examples I've worked with seem to work the same way with the CDO.Message object like in this MS Knowledge Base article KB286431. At some point SendAMessage is going to have a line that assigns the message object's .TextBody value to be equal to the emtextBody parameter you pass in.
One solution may be to copy your SendAMessage function into a new function SendAMessageHTML and replace the line where they are setting someMessage.TextBody = emtextBody so that you are setting someMessage.HTMLBody = emtextBody
Assuming your textbox has text along the lines of "<html><head><body></body></html>" you could modify your existing function to do a naive check like this:
if Left(UCase(emtextBody),6) = "<HTML>" then
someMessage.HTMLBody = emtextBody
else
someMessage.TextBody = emtextBody
end if

Related

Set a web link to a "word" in a VBA email

If this email does not display properly, please click here.
I would like to be able to have the person in the email click on the word "here" and then it will take them to a website.
This is what I have bee using but it just puts the full link into the email.
mymsg = "<HTML><BODY>"
mymsg = "If this email does not display properly, please click " & "<A href=http://us.localnews.com/ov?mailing=3TVGZMLJ-WDS49&m2u=3TVGZMLK-3TVGZMLJ-12Z630I>URL Text</A>"
mymsg = mymsg & "</BODY></HYML>"
Keep it simple, no need for the HTML/BODY tags
Example
Option Explicit
Public Sub Example()
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
With OutMail
.HTMLBody = "If this email does not display properly, please click " & _
"<A href=https://stackoverflow.com/>" & _
"Here</A>"
.Display
End With
End Sub
Make sure you are using HTMLBody Property
MSDN - HTMLBody Property
Returns or sets a String representing the HTML body of the specified item. The HTMLBody property should be an HTML syntax string. Read/write.

Validating email To field value in VBA

I am looking to validate values sent to an Outlook email in VBA
I have found several examples, such as :-
http://www.geeksengine.com/article/validate-email-vba.html
Using the code from the site above, the email address 1#1.com is returned True, or valid. However, 1#1.com; 2#1.com is returned as invalid. Whilst this isn't a valid email address, it is a valid value for a To field in Outlook.
Is it possible to validate a value such as 1#1.com; 2#1.com using VBA?
Validating an Outlook To field is a hard task.
Consider the following lines:
a#a.com<SomeName;b#b.com 'Valid, 2 addresses, first one named SomeName
a#a<a.com 'Invalid, < needs to be escaped
a#a.com.com;;b#b.com; 'Valid, 2 addresses
a#a.com;a 'Invalid, second address is not valid
a<b#a.com 'Weirdly enough, this is valid according to outlook, mails to b#a.com
'(ignores part before the <)
a#a.com<b#a.com 'But this isn't valid
'(closing > needed in this specific case, mail address = a#a.com)
The only reasonable way to validate an Outlook To field in my opinion, is to check if Outlook thinks it's valid. Any approximation is bound to go wrong.
You can use the following code to let Outlook validate the to string, and check if it can determine a mail address for each field
Public Function IsToValid(ToLine As String) As Boolean
Dim olApp As Object 'Outlook.Application
Dim mail As Object 'Outlook.MailItem
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set mail = olApp.CreateItem(0)
Dim rp As Object 'Outlook.Recipient
With mail
.To = ToLine
.Recipients.ResolveAll
For Each rp In .Recipients
If rp.Address & "" = "" Then
mail.Delete
Exit Function
End If
Next
End With
mail.Delete
IsToValid = True
End Function
Use the Split() function to split the string into the individual addresses, and check these in a loop with your function.
If all addresses are valid, the original string is valid.
The nice thing about it: you don't need separate cases. A single address without ; will return a single array element from Split(), and the loop will simply run once.
To validate multiple email ids using regex use below function:
Public Function ValidateEmailAddress(ByVal strEmailAddress As String) As Boolean
On Error GoTo Catch
Dim objRegExp As New RegExp
Dim blnIsValidEmail As Boolean
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "^((\w+([-+.]\w+)*#\w+([-.]\w+)*\.\w+([-.]\w+)*)\s*[;]{0,1}\s*)+$"
blnIsValidEmail = objRegExp.test(strEmailAddress)
ValidateEmailAddress = blnIsValidEmail
Exit Function
Catch:
ValidateEmailAddress = False
MsgBox "Module: " & MODULE_NAME & " - ValidateEmailAddress function" & vbCrLf & vbCrLf _
& "Error#: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Function

MS Access - Automatic email templates with Outlook

I have attempted to modify the code in Sorceri's answer on StackOverflow, which demonstrates how to send an email using outlook. I tried to modify this to provide a custom email template, specific to the selected entry in the database:
Private Sub Emailtemplatebtn_Click()
Dim App As Outlook.Application
Dim Mail As MailItem
Set App = CreateObject("Outlook.application")
Set Mail = oApp.CreateItem(olMailItem)
oMail.Body = "Dear" &[Forename]& "," &vbCrLf& &vbCrLf& "It has been six months or longer since I last contacted you. Have there been any big gains with regard to impact?"
oMail.Subject = &[Project name]& "- check up"
oMail.To = &Email&
oMail.Send
Set oMail = Nothing
Set oApp = Nothing
End Sub
Unfortunately, the code doesn't work. The in-built VBA editor highlights the lines "oMail.Body", "oMail.subject", and "oMail.to" in red.
I figure that this could be a very helpful feature, as it will save users even more time - the script/database will essentially handle all of the user's copy and pasting!
Solution
After using "Option Explicit", it seemed to be easier to locate why the code was failing - variables were not properly defined (I added some "o"s, and took some away). Here is the finished code:
Put "Option Explicit" at the top of the VBA page for the form (the module for the form)
Use the following code, largely corrected by Andre.
Private Sub Emailtemplatebtn_Click()
Dim App As Outlook.Application
Dim oMail As MailItem
Set App = CreateObject("Outlook.application")
Set oMail = App.CreateItem(olMailItem)
oMail.Body = "Dear" & Me![Forename] & "," & vbCrLf & vbCrLf & "It has been six months or longer since I last contacted you. Have there been any big gains with regard to impact?"
oMail.Subject = Me![Project name] & "- check up"
oMail.To = Me!Email
oMail.Send
Set oMail = Nothing
Set App = Nothing
End Sub
Change oMail.send to oMail.display if you wish to make edits to the email before sending.
You want
Dim oMail As MailItem
(note the "o")
And the syntax for & is variable & "string", note the spaces and don't use two & in a row.
Those lines should be:
oMail.Body = "Dear" & [Forename] & "," & vbCrLf & vbCrLf & "It has been six months or longer since I last contacted you. Have there been any big gains with regard to impact?"
oMail.Subject = [Project name] & "- check up"
oMail.To = Email
If the variables are controls on your form, it is better to write Me!Forename or Me![Project name] so Access knows where to look for them.

Load HTML file into VBA Microsoft Access Email

I am trying to load an HTML file into an email that gets sent by my Microsoft Access database. The email gets sent when the user clicks a button (Command109)
Here is my code that sends the email:
Private Sub Command109_Click()
'Start of code
Dim strEmail, strBody As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
'Creates an instance of Outlook
Set objOutlook = CreateObject("Outlook.Application")
DoEvents
Set objEmail = objOutlook.CreateItem(olMailItem)
DoEvents
'Creates string with email address
strEmail = PayeeEmail
strBody = "WHAT SHOULD I PUT HERE TO LOAD AN EXTERNAL HTML FILE?"
DoEvents
'Creates and sends email
With objEmail
DoEvents
.To = strEmail
DoEvents
.Subject = "Your Distribution from " & COMPANY & " has been processed."
DoEvents
.HTMLBody = strBody
DoEvents
DoEvents
.Send
End With
Set objEmail = Nothing
'Closes Outlook. Remove if you do not want to close Outlook
'objOutlook.Quit
Exit Sub
End Sub
I have this other code that allows me to load an HTML file into Outlook, but I'm not sure how to combine the code - so that the HTML file gets loaded into the BODY of the email being sent by Access.
Here is the code I have for a macro that will load an HTML file into Outlook:
Sub insertHTML()
Dim insp As Inspector
Set insp = ActiveInspector
If insp.IsWordMail Then
Dim wordDoc As Word.Document
Set wordDoc = insp.WordEditor
wordDoc.Application.Selection.InsertFile "C:\Users\me\Desktop\emailtemplate.html",
, False, False, False
End If
End Sub
Can anyone help me figure this out? Thank you for your time!
To concatenate strings on multiple lines you must have a space between the '&' and '_' as they are separate operators.
strBody = "<html><p> some of my html text here" & _ 'Note the spaces
"more formatted html text here" & _
"even more formatted html text here" & _
"don't forget your closing html brackets</p></html>"
with objEmail
.to = strTo
.subject = strSubject
.HTMKBody = strBody
.send
end with
For ease of readability in the code you can even create a seperate module with just the email string, just make sure it's public so that it can be called.
public strBody as string = your string here
I'm not sure about importing an HTML file directly, however in the past I have just placed the HTML code straight into the module. This is possible because you're using the .HTMLBody instead of .Body. You can also insert variable into the HTML code this way.
Straight HTML string
strBody = "<html> YOUR HTML CODE HERE </html>"
HTML using VBA variables
strBody = "<html><p> This is an email from " & COMPANY & ". We value your business</p></html>"
Obviously this isn't ideal if the template will change frequently. When I've done this in the past I've just made a template in outlook, copied the HTML code into VBA and then inserted variables where I wanted them.
There is likely a better way to do this though.

Disable outlook security settings using VBA

I am trying to auto email a report from access using VBA in a macro. The report is sent from Access2007 by outlook2007. When the report is being sent, I get a security message from outlook saying "a program is trying to access your Address book or Contacts" or "a program is trying to access e-mail addresses you have stored in Outlook..." . This message is a problematic for me because I want to use windows task scheduler to automatically send the report without any human interaction.So I want to disable this security notification. I searched on Google and here is the code I have so far but giving me errors and I am not sure what else I should do. Thanks for your help in advance. I am a beginner programmer. The error is
Public Sub Send_Report()
Dim strRecipient As String
Dim strSubject As String
Dim strMessageBody As String
Dim outlookapp As Outlook.Application
Set outlookapp = CreateObject("Outlook.Application")
OlSecurityManager.ConnectTo outlookapp 'error is here says object required
OlSecurityManager.DisableOOMWarnings = True
On Error GoTo Finally
strRecipient = "example#yahoo.com"
strSubject = "Tile of report"
strMessageBody = "Here is the message."
DoCmd.SendObject acSendReport, "Report_Name", acFormatPDF, strRecipient, , , strSubject, strMessageBody, False
Finally:
OlSecurityManager.DisableOOMWarnings = False
End Sub
You get the error because OlSecurityManager is nothing. You haven't declared it, you haven't set it to anything, so when you attempt to use it, VBA has no idea what you're talking about!
It looks like you're trying to use Outlook Security Manager, which is an add-in sold here. Have you purchased it? Because if not, then you probably don't have it on your system.
If you do have it, then you probably need to declare and set it like this:
Dim OlSecurityManager As AddinExpress.Outlook.SecurityManager
Set OlSecurityManager = New AddinExpress.Outlook.SecurityManager
If you, as I suspect, don't have it, then an alternative is sending e-mail using CDO. Here's an example:
First, set a reference to the CDO library in Tools > References > checkmark next to Microsoft CDO for Windows Library or something like that.
Dim cdoConfig
Dim msgOne
Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServerPort) = 25 'your port number, usually is 25
.Item(cdoSMTPServer) = "yourSMTPserver.com"
'.Item(cdoSendUserName) = "your username if required"
'.Item(cdoSendPassword) = "your password if required"
.Update
End With
Set msgOne = CreateObject("CDO.Message")
With msgOne
Set .Configuration = cdoConfig
.To = "recipient#somehwere.com"
.from = "you#here.com"
.subject = "Testing CDO"
.TextBody = "It works just fine."
.Attachments.Add "C:\myfile.pdf"
.Send
End With
This is a bit more annoying than Outlook, because you need to know in advance the address of the SMTP server to be used.
I know this is a late answer, but I just ran into a similar problem. There is another solution using Outlook.Application!
I stumble upon it while looking for the solution, full credit here:
http://www.tek-tips.com/faqs.cfm?fid=4334
But what this site's solution simply suggest, instead of using the .send command, use the `.Display" command and then send some keys from the keyboard to send the email, like below:
Sub Mail_workbook_Outlook()
'Working in Excel 2000-2016
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "Someone#Somewhere.com"
.CC = ""
.BCC = ""
.Subject = "This is an automated email!"
.Body = "Howdy there! Here, have an automated mail!"
.Attachments.Add ActiveWorkbook.FullName
.Display 'Display instead of .send
SendKeys "%{s}", True 'send the email without prompts
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End
End Sub