Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Need to disable my vba macro once I email out the file. | Excel Programming | |||
Macro To Automate File Retrieval and Email | Excel Programming | |||
Problem with macro to email file using CDO | Excel Programming | |||
Save a file and send as an email - written into macro | Excel Programming | |||
Add shortcut instead of file to Email with Macro | Excel Programming |