I'm placing my email body inside a table to easily edit the content. The problem is that there is some variables I need to use inside that body content.
For example:
I use the code bellow to send the email. And as you can see, my email body comes from a memo field inside my table (.HTMLBody = "" & Me.Html_Email_Body & "") and I need to use some variables inside the Html_Email_Body field like so:
(This is the text that I have inside my memo field)
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head></head>
<body>
Hi " & Me:PersonName & ", how are you?
</body>
</html>
The output result is: Hi " & Me.PersonName & ", how are you?
And the output result should be: Hi Bob, how are you?
Is this possible?
(This is the code I use to send my emails)
Sub SendEmail_Click()
Dim NewMail As CDO.Message
Set NewMail = New CDO.Message
'Enable SSL Authentication
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
'Make SMTP authentication Enabled=true (1)
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
'Set the SMTP server and port Details
'To get these details you can get on Settings Page of your Gmail Account
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Set your credentials of your Gmail Account
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mysite#gmail.com"
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword7"
'Update the configuration fields
NewMail.Configuration.Fields.Update
'Set All Email Properties
With NewMail
Dim strPath As String
strPath = ".mysite/wp-content/uploads/2017/07/myimage.png"
.subject = "this is the subject"
.From = "<mail#mysite.com>"
.To = Me.EMAIL
'.CC = ""
'.BCC = ""
.HTMLBody = "" & Me.Html_Email_Body & ""
.AddAttachment "https://mysite/temp/contacts.vcf"
End With
NewMail.Send
MsgBox ("This email was sent!")
'Set the NewMail Variable to Nothing
Set NewMail = Nothing
End Sub
I do this kind of thing in many of my applications. I insert Field References into my email templates and then use a routine I wrote to replace them dynamically with the correct values at runtime. In my case, this is usually done in a loop with a RecordSet that contains several people who are each receiving an individual copy of the email message and I am customizing the template for each recipient.
Here is a small sample email template:
<p>Hello [RecipFirstName],</p> This auto-generated email has been sent to notify you that:
<h4>Approval Mailed is <b>LATE</b>.</h4>
Approval Mailed Date: [ApprovalMailed_Date]
[ProjectTemplate1]
Then my code to fill the template looks like:
'[mBody] is a string that will be the Body of the email
'[templateBody] is a string that was previously set to the email
' template for the message being processed
'[rstProject] is a DAO.RecordSet that was previously set to the
' required dataset for my purposes
'Notice that I use a combination of [Replace] functions and
' my custom function [sitsProcessFieldReferences] to update the
' template with the appropriate values.
'In my case, replace CRLF in the template with <BR>
mBody = Replace(templateBody, vbCrLf, "<BR>")
mBody = sitsProcessFieldReferences(mBody, rstProject)
'The following examples use variables I have already defined and
' populated to replace the field refernces.
mBody = Replace(mBody, "[RecipFirstName]", FirstName)
mBody = Replace(mBody, "[RecipLastName]", LastName)
mBody = Replace(mBody, "[RecipFullName]", FirstName & " " & LastName)
mBody = Replace(mBody, "[ProjectTemplate1]", pTemplate1)
Finally the function that does the field reference replacement. Notice that I have a special case that if I name a field reference with "price" in the name, I want the replacement value formatted as Currency. You can customize this code for any situation. It just requires some pre-planning to keep a consistent naming convention for your field references.
This function takes an email template (or any text string) and searches it for field names matching any field in the RecordSet (enclosed in square brackets) and replaces that reference with the value from the corresponding field in the RecordSet
Public Function sitsProcessFieldReferences(ByVal orgString As String, rstFields As DAO.Recordset) As String
On Error GoTo Err_PROC
Dim ErrMsg As String
Dim fld As DAO.Field
For Each fld In rstFields.Fields
If InStr(fld.Name, "price") Then
orgString = Replace(orgString, "[" & fld.Name & "]", Format(Nz(fld.Value, 0), "Currency"))
Else
orgString = Replace(orgString, "[" & fld.Name & "]", Nz(fld.Value, ""))
End If
Next fld
Set fld = Nothing
Exit_PROC:
sitsProcessFieldReferences = orgString
Exit Function
Err_PROC:
Select Case Err.Number
Case Else
ErrMsg = "Module: " & strModName & vbCrLf
ErrMsg = ErrMsg & "Error: " & Err.Number & vbCrLf
ErrMsg = ErrMsg & "Line: " & Erl() & vbCrLf
ErrMsg = ErrMsg & Err.Description
DoCmd.Hourglass False
MsgBox ErrMsg, vbOKOnly + vbCritical, "Function sitsProcessFieldReferences"
Resume Exit_PROC
Resume
End Select
End Function
In your email template, you would change the following line:
Hi " & Me:PersonName & ", how are you?
to something like:
Hi [PersonName], how are you?
Then either do a Replace(emailTemplate, [PersonName], "Bob") if you have the replacement values already in a variable or something.
Or, if the value is in a RecordSet, you would change [PersonName] in the template to match the name of the field in the RecordSet that contains the value Bob and then use my custom function: sitsProcessFieldReferences(emailTemplate, YourRecordSet)
I manage to find the solution myself because I couldn't implement #Jericho Johnson although it was somehow useful...
What I did was setup a new variable (MyHTMLBody) for the email body and several replacements as I need (see bellow).
After that, I setup the .HTMLBody = MyHTMLBody this way, and now I can use some bookmarks in the HTML like this: Hi [r_name], how are you? This is your [r_email].
MyHTMLBody = Me.Body
MyHTMLBody = Replace(MyHTMLBody, "[r_name]", Me.Client_Name)
MyHTMLBody = Replace(MyHTMLBody, "[r_email]", Me.Client_Email)
.HTMLBody = MyHTMLBody
Related
I have a macro allows me send emails of monthly performance to each manager. Codes are as follow:
Sub OutlookEmailsSend()
Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem
Dim lCounter As Long
Dim endColumnNo As Long
Dim a As Long
Dim sFile As String
endColumnNo = ThisWorkbook.Sheets("Sheet1").UsedRange.Columns.Count
Set objOutlook = Outlook.Application
For lCounter = 2 To 3
'
Set objMail = objOutlook.CreateItem(olMailItem)
objMail.To = Sheet1.Range("B" & lCounter).Value
objMail.Subject = "Sales Summary"
sFile = "Dear,<br><br>Please refer to below table for your performance<br><br><table border=1>"
For a = 1 To endColumnNo
sFile = sFile & "<tr><td>" & Cells(1, a) & "</td><td>" & Cells(lCounter, a) & "</td></tr>"
Next
objMail.HTMLBody = sFile
objMail.Display
Set objMail = Nothing
Next
End Sub
The macro produce table like this
Dear,
Please refer to below table for your performance
Name Tom
Email sgcjack#163.com
Item Phone
Sales 123
Bonus 3213
However, I would like the table presents as follow
Name Email Item Sales Bonus
Jack jacksun#citics.com.hk Computer 342 23123
Is there any way can do this?
For the sake of better readibility it might be helpful to organize the html creation in a function and to assign the function result to objMail.HTMLBody omitting the loops.
Btw you forgot the closing table tag </table> which wouldn't result in a valid html structure. - Of course, the most direct approach following the original code would be to follow the recommendation in comment to add the <tr>..</tr> tags outside the loop not forgetting the closing </table> tag.
With Sheet1
objMail.HTMLBody = getBody(.Range("A1",.Cells(1,EndColumnNo)),"Dear xx")`
End With
The help function getBody() joins (a) headers and (b) table data based on a (c) clearly defined table structure.
Note: You can play around and change that definition to a more sophisticated html code with separate header tags, too..
Function getBody(rng As Range, _
Optional greetings As String = "", _
Optional HeaderList As String = "Name,Email,Item,Sales,Bonus")
Const Blanks As String = " "
'a) get headers
Dim headers As String
headers = " <td>" & Replace(HeaderList, ",", "</td><td>") & "</td>"
'b) join table data "<td>..</td>"
Dim data As String
data = Blanks & _
Join(rng.Parent.Evaluate("""<td>""&" & rng.Address(0, 0) & " & ""</td>""") _
, vbNewLine & Blanks)
'c) define table structure
Dim tags()
tags = Array(greetings, _
"<table border='1'>", _
" <tr>", headers, " </tr>", _
" <tr>", data, " </tr>", _
"</table>")
'd) return joined function result
getBody = Join(tags, vbNewLine)
End Function
I am trying to send separate Employees a PDF/page of their section/report. The information is based on their EmployeeID (which is text not long number). So each person has their balance information on a page then there's a page break, and then next page shows the next person's details. With the code below, it does email each of the employees one page but it so happens to only email the first person's page to EVERYONE. Is it possible to somehow automate each week so that each user is emailed his/her individual page of the report?
Another error is that the email pop up one by one so I have to press send each time for over 200 people, and that the email seems to be sending to the email but then followed by #mailto:the email# for example email#email.com#mailto:email#email.com#
I just started Access and have been copying and scraping code off of places I have found online. Many thanks in advance, if you can assist!
Have a great day!
Private Sub cmdSendAll_Click()
Dim rsAccountNumber As DAO.Recordset
Dim strTo As Variant
Dim strSubject As String
Dim strMessageText As String
Set rsAccountNumber = CurrentDb.OpenRecordset("SELECT DISTINCT EmployeeID, [Email] FROM [queAutoUpdate]", dbOpenSnapshot)
Debug.Print strTo
With rsAccountNumber
Do Until .EOF
DoCmd.OpenReport "test", _
acViewPreview, _
WhereCondition:="EmployeeID = '" & !EmployeeID & "'", _
WindowMode:=acHidden
strTo = ![Email]
strSubject = "Updated Balance "
strMessageText = "Text Here"
DoCmd.SendObject ObjectType:=acSendReport, _
ObjectName:="test", _
OutputFormat:=acFormatPDF, _
To:=strTo, _
Subject:=strSubject, _
MESSAGETEXT:=strMessageText, _
EditMessage:=True
DoCmd.Close acReport, "Unaffirmed Report", acSaveNo
.MoveNext
Loop
.Close
End With
End Sub
Your opening a report called test and then closing another report called "Unaffirmed Report". You need to open and close the same report, in this case "test".
DoCmd.Close acReport, "test", acSaveNo. This should fix the employee data not updating, since the report remains open on the first employee.
To directly send the message you need change EditMessage:=True to EditMessage:=False.
Check the docs:
https://learn.microsoft.com/en-us/office/vba/api/access.docmd.sendobject
Also if you need to test this, set outlook in Offline mode, and run your code, check the messages in your Outbox to see if they're as expected. You can delete the messages from the Outbox to prevent them from being sent. Once you're finished with testing you can set Outlook back to Online Mode.
Regarding the email address issue, this comes automatically when using hyperlinks in your controls. You'll need to strip the extra part out with strTo = Left(![Email],InStr(![Email],"#")-1). Check your data if this will be valid for all email addresses. For a more advanced solution you can look at this post https://codekabinett.com/rdumps.php?Lang=2&targetDoc=access-hyperlink-data-type.
Code provided as reference, please see the post for the explanation.
'copied from https://codekabinett.com/rdumps.php?Lang=2&targetDoc=access-hyperlink-data-type
Public Function GetHyperlinkFullAddress(ByVal hyperlinkData As Variant, Optional ByVal removeMailto As Boolean) As Variant
Const SEPARATOR As String = "#"
Dim retVal As Variant
Dim tmpArr As Variant
If IsNull(hyperlinkData) Then
retVal = hyperlinkData
Else
If InStr(hyperlinkData, SEPARATOR) > 0 Then
' I append 4 separators at the end, so I don't have to worry about the
' lenght of the array returned by Split()
hyperlinkData = hyperlinkData & String(4, SEPARATOR)
tmpArr = Split(hyperlinkData, SEPARATOR)
If Len(tmpArr(1)) > 0 Then
retVal = tmpArr(1)
If Len(tmpArr(2)) > 0 Then
retVal = retVal & "#" & tmpArr(2)
End If
End If
Else
retVal = hyperlinkData
End If
If Left(retVal, 7) = "mailto:" Then
retVal = Mid(retVal, 8)
End If
End If
GetHyperlinkFullAddress = retVal
End Function
Consider using the MS Outlook object library to send emails. Whereas DoCmd.SendObject is a convenience handler, you control more of the process with initializing an Outlook application object and creating an Outlook email object setting all needed elements.
However, with this approach you need to first export your filtered report to PDF and then attach to email for final send. See inline comments for specific details.
Dim rsAccountNumber As DAO.Recordset
' CHECK Microsoft Outlook #.# Object Library UNDER Tools/References
Dim olApp As Outlook.Application, olEmail As Outlook.MailItem
Dim fileName As string, todayDate As String, strEmail As String
todayDate = Format(Date, "YYYY-MM-DD")
Set rsAccountNumber = CurrentDb.OpenRecordset("SELECT DISTINCT EmployeeID, [Email] FROM [queAutoUpdate]", dbOpenSnapshot)
Set olApp = New Outlook.Application
With rsAccountNumber
Do Until .EOF
' SETTING FILE NAME TO SAME PATH AS DATABASE (ADJUST AS NEEDED)
fileName = Application.CurrentProject.Path & "\Balance_Report_" & !EmployeeID & "_" & todayDate & ".pdf"
' OPEN AND EXPORT PDF TO FILE
DoCmd.OpenReport "test", acViewPreview, "EmployeeID = '" & !EmployeeID & "'"
' INTENTIONALLY LEAVE REPORT NAME BLANK FOR ABOVE FILTERED REPORT
DoCmd.OutputTo acReport, , acFormatPDF, fileName, False
DoCmd.Close acReport, "test"
' CREATE EMAIL OBJECT
strEmail = ![Email]
Set olEmail = olApp.CreateItem(olMailItem)
With olEmail
.Recipients.Add strEmail
.Subject = "Updated Balance"
.Body = "Text Here"
.Attachments.Add fileName ' ATTACH PDF REPORT
.Send ' SEND WITHOUT DISPLAY TO SCREEN
End With
Set olEmail = Nothing
.MoveNext
Loop
.Close
End With
MsgBox "All emails successfully sent!", vbInformation, "EMAIL STATUS"
Set rsAccountNumber = Nothing: Set olApp = Nothing
I am writing some VBA in MS Access, although the principle of my question would apply just as well to Excel or Word VBA. I have written a function GetStringParameterFromTable which returns a string value. It is possible that the function may result in a VBA-generated error, despite my best efforts to write it so that it does not. If an error happens, I don't want the code to crash, so I must use error handling. However, I don't want the code to display an error message and stop within the function if there is an error. I want the function to finish executing and return control to the calling procedure, and then I want the calling procedure to display the error message and tidy up, e.g. close open files. My question is: how does the calling procedure know that there has been an error in the function it called, and how does it get the error message?
I have thought of three ways of implementing this:
(1) Make GetStringParameterFromTable into a Sub, and pass it ParameterValue, ErrorFlag and ErrorMessage by reference.
(2) Keep GetStringParameterFromTable as a Function, define ErrorFlag and ErrorMessage as global variables and have the function alter ErrorFlag and ErrorMessage.
(3) Keep GetStringParameterFromTable as a Function and define a type with three components – ParameterValue, ErrorFlag and ErrorMessage – and make GetStringParameterFromTable return a value of the type I have defined.
I think that my requirement must be quite common, but I can’t find any examples of how it’s implemented. Does anyone have any views on which of my suggestions is the best way, or whether there is a better way that I haven’t thought of?
I have been contemplating the same thing since C#.net has implemented Tuples. I have implemented Tuples using VBA's type to create my tuples. What I have done is the following:
Public Type myTuple
Value as String 'Or whatever type your value needs to be
ErrCode as Long
ErrDesc as String
End Type
Public Function DoWork (ByRef mObject as MyClass) as myTuple
Dim retVal as myTuple
'Do whatever work
If Err.Number <> 0 then
retVal.Value = Nothing
retVal.ErrNumber = Err.Number
retVal.ErrDesc = Err.Description
Else
Set retVal.Value = Whatever Makes Sense
retVal.ErrNumber = 0
retVal.ErrDesc = VbNullString
End If
DoWork = retVal
End Function
I would like to be more specific, but you didn't provide a code example.
I am doing it like this and log the errors in a table:
' Lookups Replacements
'---------------------
Function DLook(Expression As String, Domain As String, Optional Criteria) As Variant
On Error GoTo Err_Handler
Dim strSQL As String
strSQL = "SELECT " & Expression & " FROM " & Domain 'DLookup
'DCount: strSQL = "SELECT COUNT(" & Expression & ") FROM " & Domain
'DMax: strSQL = "SELECT MAX(" & Expression & ") FROM " & Domain
'DMin: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DFirst: strSQL = "SELECT FIRST(" & Expression & ") FROM " & Domain
'DLast: strSQL = "SELECT LAST(" & Expression & ") FROM " & Domain
'DSum: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DAvg: strSQL = "SELECT AVG(" & Expression & ") FROM " & Domain
If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria
DLook = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)(0)
Exit Function
Err_Handler:
'Can be made as Error Sub as well
Dim ErrNumber as Integer
Dim ErrDescription as String
ErrNumber = Err.Number
ErrDescription = Err.Description
Err.Clear
On Error Resume Next
Dim strSQL as String
strSQL = "INSERT INTO tblErrorLog (ErrorNumber, ErrorDescription) VALUES (" & ErrNumber & ", '" & ErrDescription & "')"
Currentdb.Excecute strSQL, dbFailOnError
End Function
Called with:
If DLook("Column2", "Table1", "Column1 = " & ID) = 0 Then
'Do stuff
End If
If DLook("Column2", "Table1") = 0 Then
'Do other stuff
End If
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
I created an Macro in MS Outlook for an email. The user inputs an answer to a question which results in a variable storing that data as a string. An email is then generated in HTML with a hyperlink containing that variable. I can't seem to figure out how to concatenate the variable "strTrackingNumber" into the complete hyperlink. Any suggestions?
Option Explicit
Sub TestFile
Dim strTrackingNumber as String
strTrackingNumber = InputBox("Please input the Tracking Number")
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
.To = "mickey.smith#surfer.com"
.CC = ""
.BCC = ""
.Subject = "Forecast"
.Categories = ""
.BodyFormat = olFormatHTML ' send HTML message
.HTMLBody = "<style> body{color:black;font-family:Arial;font-size: 12pt;}" & _
"<HTML><body>Dear Member,<br><br> The following document is ready for your review."<a href= 'http://www.bluewave.com/' & strTrackingNumber>Tracking & strTrackingNumber.</a></body>
.Display
End With
Set objMsg = Nothing
End Sub
Output link should look like this: http://www.bluewave.com/Tracking Number
e.g. http://www.bluewave.com/RA-15-30922
.HTMLBody = "<style> body{color:black;font-family:Arial;font-size: 12pt;} </style>" & _
"<HTML><body>Dear Member,<br><br> " & _
"The following document is ready for your review. " & _
"<a href= 'http://www.bluewave.com/" & strTrackingNumber & "'>Tracking " & _
strTrackingNumber & ".</a></body>"