PDA

View Full Version : Add an HTML file as body of email



starsky
09-19-2011, 07:15 AM
Hi,

I've been successfully using the code below to send emails with attachments, but have been pasting the body manually when the email is available for review before sending. I would like to have the email body added automatically. I believe for a body that is above a 255 character limit HTML is the way to go. However, I've not been able to successfully integrate the relevant code in order to do this.

Is it possible with this code?
This uses a function from Jimmy Pena's excellent site
Sub SendIt()
Dim fn
fn = Application.GetOpenFilename
Range("A6") = fn
Range("A18").Formula = "=SendMessage(A1,A2,A3,A4,A5,A6,A7)"
End Sub

This is the function.
Function SendMessage(Msg As String, Subject As String, EmailTo As String, _
Optional EmailCC As String, Optional EmailBCC As String, _
Optional Attachment As String, _
Optional Importance As ImportanceLevel = 1)
' fill out Outlook email message using function parameters
' by Jimmy Pena, http://www.codeforexcelandoutlook.com, October 18 2009
On Error Resume Next
Const olMailItem As Long = 0
Dim Outlook As Object ' Outlook.Application
Dim OutlookMsg As Object 'Outlook.MailItem

' create Outlook session
Set Outlook = GetOutlookApp
If Outlook Is Nothing Then GoTo ProgramExit
' create msg
Set OutlookMsg = Outlook.CreateItem(olMailItem)
With OutlookMsg
' set basic params
.Subject = Subject
.HTMLBody = Msg
.To = EmailTo
' add cc's (if any)
If Len(EmailCC) > 0 Then
.CC = EmailCC
End If

'add body of email
If Len(EmailCC) > 0 Then
'.HTMLBody =
End If

' add bcc's (if any)
If Len(EmailBCC) > 0 Then
.BCC = EmailBCC
End If
' add attachments
If Len(Attachment) > 0 Then
If Len(Dir(Attachment)) > 0 Then '.Attachments.Add (Attachment)
.Attachments.Add (Attachment)

End If
End If
' set importance
Select Case Importance
Case 0 ' high
.Importance = 2
Case 1 ' medium
.Importance = 1
Case 2 ' low
.Importance = 0
End Select
.Display
End With
ProgramExit:
Exit Function
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Function

The code elements that I've tried to use (with declarations) are:

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFS = oFSO.OpenTextFile("C:\test.html")
stext = oFS.readall

.BodyHTML would then equal stext



Thanks.