Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Sending html email from VBA email program

Tags:

html

vba

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

like image 687
jpl458 Avatar asked Apr 02 '15 17:04

jpl458


1 Answers

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
like image 127
jbay Avatar answered Nov 10 '22 06:11

jbay