Excel to Outlook HTML: This page uses frames Error

[waterboy202]

Hello,

I am trying to save an excel generated html file and use that for the body of the e-mail generated to Outlook. I receive the following message "This page uses frames, but your browser doesn't support them." Do you know how to fix this? Below is the code.

Thanks,


Sub GenEmail()

Dim ThisMainWorkbook As String

ThisMainWorkbook = ThisWorkbook.Name
Windows(ThisMainWorkbook).Activate

Call MakeEmailBody
Dim HTMLpaTh As String

'Save e-mail Settings
FromEmail = Sheets("E-Mail Setup").Range("A11").Value
Recipients = Sheets("E-Mail Setup").Range("B11").Value
CCeMails = Sheets("E-Mail Setup").Range("C11").Value
EmailSubjectName = Sheets("E-Mail Setup").Range("D11").Value
EMailBody = Sheets("E-Mail Setup").Range("E11").Value
WBPassWord = Sheets("E-Mail Setup").Range("F11").Value

HTMLpaTh = Sheets("E-Mail Setup").Range("B8").Value

'Check Filepath
If Right$(HTMLpaTh$, 1) = "\" Or Right$(HTMLpaTh$, 1) = "/" Then
Else
HTMLpaTh = HTMLpaTh & "\"
End If
If Right$(ReportSaveLoc$, 1) = "\" Or Right$(ReportSaveLoc$, 1) = "/" Then
Else
ReportSaveLoc = ReportSaveLoc & "\"
End If


''--------------------Setup Email
Dim OlApp As Object
Dim OlMail As Object
Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.createitem(olmailitem)

OlMail.SentOnBehalfOfName = FromEmail
OlMail.To = Recipients
OlMail.cc = CCeMails
OlMail.Subject = EmailSubjectName

Dim oFSO As Object
Dim oFS As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFS = oFSO.OpenTextFile(HTMLpaTh & "PnLemail.htm")

stext = oFS.readall
OlMail.HTMLBody = stext
OlMail.Save

Set OlMail = Nothing
Set OlApp = Nothing

On Error Resume Next
'Kill HTMLpaTh & "PnLemail.htm"

On Error GoTo 0

MsgBox "Done. E-mail Sent to Drafts/Inbox.", vbOKOnly, "Done"
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub
Sub MakeEmailBody()
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim ThisMainWorkbook As String
Dim TempWB As String
Dim HTMLpaTh As String
Dim EMailBody As String
Dim LastRow As Long
Dim ActiveRowCount As Long, LastActiveRowCT As Long

ThisMainWorkbook = ThisWorkbook.Name

Workbooks.Add
TempWB = ActiveWorkbook.Name

' ------------Copy files to Images on new WB
Windows(ThisWorkbook.Name).Activate
ActiveRowCount = 0
Sheets("Sharepoint").Select
LastRow = Sheets("Sharepoint").Range("A22").End(xlUp).Row
Range("A6:G" & LastRow).Copy
Windows(TempWB).Activate
Range("A6").Select
ActiveSheet.Pictures.Paste.Select
ActiveRowCount = ActiveRowCount + LastRow + 2

Windows(ThisWorkbook.Name).Activate
LastRow = Sheets("Sharepoint").Range("A1048576").End(xlUp).Row
Range("A25:G" & LastRow).Copy
Windows(TempWB).Activate
Range("A" & ActiveRowCount).Select
ActiveSheet.Pictures.Paste.Select
ActiveRowCount = LastRow - 24 + ActiveRowCount + 1


'-----------End Copy files to Images on New WB


'Setup Body
EMailBody = Workbooks(ThisMainWorkbook).Worksheets("E-Mail Setup").Range("E11").Value
HTMLpaTh = Workbooks(ThisMainWorkbook).Worksheets("E-Mail Setup").Range("B8").Value

Range("A1").FormulaR1C1 = EMailBody
Range("A1").Font.Size = 11

On Error Resume Next
Sheets("Sheet3").Delete
Sheets("Sheet2").Delete
On Error GoTo 0

ActiveWorkbook.SaveAs Filename:=HTMLpaTh & "PnLemail.htm", _
FileFormat:=xlHtml, ReadOnlyRecommended:=False, CreateBackup:=False

Windows(ThisWorkbook.Name).Activate

End Sub