HTML formatted emails from VBA
DeZZar
I am hoping someone here can point me in the right direction.
I desperately need to send HTML formatted emails from Access. I never
thought it would be so hard to find information on this or even some
example working code, but apparently everyone thats ever gotten this
working has never posted back on forums on how to do it!
A further complication is that I need to use lotus notes. I currently
use the code below extensively to send emails and attachments from
access - but I cannot seem to find a way to get text formatting into
the body text of the email.
Here is the basic nuts and bolts, tidied up version of the working
lotus notes email code.
I just need a way of getting the "strBody" into HTML! Sounds simple
enough...
'## Existing Lotus Notes mail coded here ##
Private Sub LotusEmail()
On Error GoTo Err_LotusEmail
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'The current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim strBody As String 'Email body text
Set Session = CreateObject("Notes.NotesSession")
Set Maildb = Session.getDatabase("", MailDbName)
If Maildb.ISOPEN = True Then
Else
Maildb.OPENMAIL
End If
'Email body text _
Need to put this into html. _
Simply adding html tags doesn't work
strBody = "Hi Bob," & vbCrLf & _
vbCrLf & "This is supposed to be a HTML email!" & vbCrLf & _
vbCrLf & "But it isn't is it?"
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.SendTo = "na...@isp.com"
MailDoc.CopyTo = ""
MailDoc.BlindCopyTo = ""
MailDoc.Principal = "John Smith"
MailDoc.ReplyTo = ""
MailDoc.subject = "email subject"
MailDoc.body = strBody
MailDoc.SAVEMESSAGEONSEND = False
' True if email to be saved in sent items
' Include if attachements required
' Set AttachME = MailDoc.CreateRichTextItem("Attachemt")
' Set EmbedObj = AttachME.EmbedObject(1454, "", "C:\File path in
here")
MailDoc.CreateRichTextItem ("Attachement")
MailDoc.SEND 0, recipient
'Clean up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
Exit_LotusEmail:
Exit Sub
Err_LotusEmail:
MsgBox "The following error has occured" & _
vbCrLf & vbCrLf & Err.Number & "-" & Err.Description & _
vbCrLf & vbCrLf & "Please report to system administration",
vbOKOnly + vbCritical, "Lotus Notes Email Error"
End Sub
'## End Existing Lotus Notes code ##
Any help would be greatly appreciated as I am absolutely spent
searching for this topic....:(
Cheers
DeZZar
Roger
Roger
>
> - Show quoted text -
I also found this link
http://www-10.lotus.com/ldd/nd6forum.nsf/d6091795dfaa5b1185256a7a0048a2d0/8994c95e64a523f1852573a3004dd41a?OpenDocument
Phil Stanton
in the reference section
Here is some code which you can adapt
Public Function EMailMessage(Subject As String, ID As Long, WhoTo As Byte,
FormName As String) As Boolean
'?EMailMessage("This is a test.doc" , 43,1,"Cruises")
Dim FlgQuit As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim OlInspector As Outlook.Inspector
Dim MyDb As Database
Dim ToSet As Recordset
Dim SQLStg As String, MailToStg As String
Dim rtf As RTF2
Dim RTF2HTML As New EasyByte.RTF2HTMLv8
Set rtf = Forms!EMailText!EMailText.Object
Set MyDb = CurrentDb
Select Case FormName
Case "Cruises" ' Called from Cruise Form
'Boats on cruise with EMail Addresses
SQLStg = "SELECT QJnBoatCruise.*, Member.MemSurName,
Member.MemFirstName, Member.MemEMail, jnMemSpaceBoat.MainSailor "
SQLStg = SQLStg & "FROM QJnBoatCruise INNER JOIN (Member INNER JOIN
jnMemSpaceBoat "
SQLStg = SQLStg & "ON Member.MemberID = jnMemSpaceBoat.MemberID) ON
QJnBoatCruise.BoatID = jnMemSpaceBoat.BoatID "
SQLStg = SQLStg & "WHERE ((QJnBoatCruise.CruiseID = " & ID
SQLStg = SQLStg & ") AND (Member.MemEMail Is Not Null) AND
(jnMemSpaceBoat.MainSailor = True)"
If WhoTo = 1 Then ' All Interested
SQLStg = SQLStg & ");"
Else ' All Confirmed
SQLStg = SQLStg & " AND (QJnBoatCruise.Participated = True));"
End If
Case Else
MsgBox "No query defined", vbCritical
Exit Function
End Select
Set ToSet = MyDb.OpenRecordset(SQLStg)
With ToSet
Do Until .EOF
MailToStg = MailToStg & !MemEMail & ";"
.MoveNext
Loop
.Close
Set ToSet = Nothing
End With
' MailToStg = "ph...@stantonfamily.co.uk;"
MailToStg = Left(MailToStg, Len(MailToStg) - 1) ' Remove last
semicolon
EMailMessage = False ' Default situation
On Error GoTo Err_EMailMessage
'Get Outlook if it's running
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err.Number = 0 Then
FlgQuit = False
Else
Set oOutlookApp = CreateObject("Outlook.Application")
FlgQuit = True
End If
On Error GoTo 0
Err.Clear
On Error GoTo Err_EMailMessage
'Create a new mailitem
Set oItem = oOutlookApp.CreateItem(OLMailItem)
With oItem
'Set the recipient for the new email
.BCC = MailToStg
'Set the recipient for a copy
.CC = ""
'Set the subject
.Subject = Subject
'The content of the document is used as the body for the email
RTF2HTML.RTF_Text = rtf.RTFtext
'RTF2HTML.Generator = "My Own RTF-2-HTML Convertor"
RTF2HTML.CleanRTF = "yes"
RTF2HTML.CleanHTML = "no"
RTF2HTML.XHTMLOutput = "no"
RTF2HTML.Links = "yes"
RTF2HTML.DoDebug = "yes"
RTF2HTML.ConvertImages = "yes"
'RTF2HTML.ImageFolder = System.IO.Path.GetTempPath
RTF2HTML.ImageFormat = "png"
RTF2HTML.ImageName = "image"
RTF2HTML.LicenseKey = "DEMO"
.Body = ""
.HTMLBody = RTF2HTML.ConvertRTF
.Send
End With
EMailMessage = True
If FlgQuit = True Then
oOutlookApp.Application.Quit
End If
CleanUp:
Set oItem = Nothing
Set oOutlookApp = Nothing
Exit Function
Err_EMailMessage:
If Err = 287 Then ' No to send email
MsgBox "Email not sent", vbInformation
Else
MsgBox Err.Description
End If
GoTo CleanUp
End Function
"Roger" <lespe...@natpro.com> wrote in message
news:e37b41ed-a5c8-4571...@t32g2000yqj.googlegroups.com...
DeZZar
>
> - Show quoted text -
MailDoc.HTMLBody returns a blank email unfortunately.
DeZZar
>
> - Show quoted text -
well the link looked promicing, but when you paste the code, a whole
stack of it is invalid.
I seem to be having issues with lines like:
Dim message As New NotesDocument (db)
Dim smtpo As New NotesItem
(message,"SMTPOriginator","chris_...@mydomain.com",NAMES)
and basically any line that contains HTML tags....so I'm assuming that
this is not a functioning VBA sub.
Phil, thank you for your example, but unfortunately I'm new enough to
VB that I wouldn't know where to begin to take my code above and
change it to include elements of what you have provided...:(
Has anyone working with lotus notes sucessfully established a simble
mail code which provides for HTML body text?
Phil Stanton
and you are trying to feed it RTF. You need to convert the RTF to HTML,
hence my suggestion you look at http://www.easybyte.com/
Phil
"DeZZar" <derrick....@gmail.com> wrote in message
news:5234dddd-f6ab-4515...@z4g2000prh.googlegroups.com...