Macro to Add More Than One HTM File to an Email
 

So right now this code will create an email then put a .htm file into
the body of the email. What I want to be able to do is have more than
one (maybe even three or four) .htm file(s) to be added to the body
(back to back to just look like a longer email). Does anyone know how
to do this? Or possibly have a better solution to my problem?

Thanks,

Tyson

============================

Sub SendEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim body As String
Dim cell As Range
Dim strto As String
Dim subject As String


On Error Resume Next
For Each cell In ThisWorkbook.Sheets("Data Base") _
.Range("C5:C100").Cells.SpecialCells(xlCellTypeCon stants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0,
-2).Value) = "yes" Then
strto = strto & cell.Value & ";"
End If
Next cell
On Error GoTo 0
If Len(strto) 0 Then strto = Left(strto, Len(strto) - 1)

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

subject = Sheets("facts").Range("C15").Value & "-- " &
Sheets("facts").Range("C13").Value _
& " -- " & Sheets("facts").Range("C12").Value
attach = Sheets("facts").Range("C7").Value
attach2 = Sheets("facts").Range("C8").Value
attach3 = Sheets("facts").Range("C9").Value
attach4 = Sheets("facts").Range("C10").Value
attach5 = Sheets("facts").Range("C11").Value

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = strto
.subject = subject
.htmlbody = Get_Body
.Attachments.Add attach
If attach2 < "" Then
.Attachments.Add attach2
If attach3 < "" Then
.Attachments.Add attach3
If attach4 < "" Then
.Attachments.Add attach4
If attach5 < "" Then
.Attachments.Add attach5
End If
End If
End If
End If
.Display
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Function Get_Body() As String
Dim ie As Object, nav As String

nav = Sheets("facts").Range("C6").Value

Set ie = CreateObject("InternetExplorer.Application")
With ie
ie.Visible = False
ie.navigate nav
'.navigate "C:\test attachment.htm"
Do Until .ReadyState = 4
Loop
Get_Body = .Document.body.InnerHTML
.Quit

End With
Set ie = Nothing
End Function

Macro to Add More Than One HTM File to an Email
 

Solved my own problem again (well also with help from Ron de Bruin's
website!)

Answer is:

.htmlbody = Get_Body & Get_Body2

And a second function for it

T


On May 29, 8:09*am, Tysone wrote:
So right now this code will create an email then put a .htm file into
the body of the email. *What I want to be able to do is have more than
one (maybe even three or four) .htm file(s) to be added to the body
(back to back to just look like a longer email). *Does anyone know how
to do this? *Or possibly have a better solution to my problem?

Thanks,

Tyson

============================

Sub SendEmail()
* * Dim OutApp As Object
* * Dim OutMail As Object
* * Dim body As String
* * Dim cell As Range
* * Dim strto As String
* * Dim subject As String

* * On Error Resume Next
* * For Each cell In ThisWorkbook.Sheets("Data Base") _
* * * * .Range("C5:C100").Cells.SpecialCells(xlCellTypeCon stants)
* * * * If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0,
-2).Value) = "yes" Then
* * * * * * strto = strto & cell.Value & ";"
* * * * End If
* * Next cell
* * On Error GoTo 0
* * If Len(strto) 0 Then strto = Left(strto, Len(strto) - 1)

* * Set OutApp = CreateObject("Outlook.Application")
* * OutApp.Session.Logon
* * Set OutMail = OutApp.CreateItem(0)

* * subject = Sheets("facts").Range("C15").Value & "-- *" &
Sheets("facts").Range("C13").Value _
* * *& " -- *" & Sheets("facts").Range("C12").Value
* * attach = Sheets("facts").Range("C7").Value
* * attach2 = Sheets("facts").Range("C8").Value
* * attach3 = Sheets("facts").Range("C9").Value
* * attach4 = Sheets("facts").Range("C10").Value
* * attach5 = Sheets("facts").Range("C11").Value

* * On Error Resume Next
* * With OutMail
* * * * .To = ""
* * * * .CC = ""
* * * * .BCC = strto
* * * * .subject = subject
* * * * .htmlbody = Get_Body
* * * * .Attachments.Add attach
* * * * * * If attach2 < "" Then
* * * * * * .Attachments.Add attach2
* * * * * * * * If attach3 < "" Then
* * * * * * * * .Attachments.Add attach3
* * * * * * * * * * If attach4 < "" Then
* * * * * * * * * * .Attachments.Add attach4
* * * * * * * * * * * * If attach5 < "" Then
* * * * * * * * * * * * .Attachments.Add attach5
* * * * * * * * End If
* * * * * * * End If
* * * * * * End If
* * * * *End If
* * * * .Display
* * End With
* * On Error GoTo 0

* * Set OutMail = Nothing
* * Set OutApp = Nothing
End Sub

* * * * * * Function Get_Body() As String
* * * * * * Dim ie As Object, nav As String

* * * * * * nav = Sheets("facts").Range("C6").Value

* * * * * * Set ie = CreateObject("InternetExplorer.Application")
* * * * * * With ie
* * * * * * * * ie.Visible = False
* * * * * * * * ie.navigate nav
* * * * * * * * '.navigate "C:\test attachment.htm"
* * * * * * * * Do Until .ReadyState = 4
* * * * * * * * Loop
* * * * * * * * Get_Body = .Document.body.InnerHTML
* * * * * * * * .Quit

* * * * * * End With
* * * * * * Set ie = Nothing
* * * * * * End Function