CODEWITHSUNDEEP
htmlvba
jpl458
jpl458

Reputation: 615

Sending html email from VBA email program

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 = "[email protected]"
  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

Upvotes: 8

Views: 44878

Answers (2)

jbay
jbay

Reputation: 126

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)
'& "<a href=""\\server\folder"">\\server\folder</a>" &
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

Upvotes: 10

nvuono
nvuono

Reputation: 3363

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

Upvotes: 0

Related Questions