Deepak9900
New Member
Hi,
I am writing a macro for sending the excel data that contains picture and text. I have also created the code which is sending the email to multiple recipients. But the code is not pasting the image and only pasting the text and sending the email.
The code is :
Please help in adding the right code for selecting everything from the sheet. Thanks!!
I am writing a macro for sending the excel data that contains picture and text. I have also created the code which is sending the email to multiple recipients. But the code is not pasting the image and only pasting the text and sending the email.
The code is :
Code:
Sub Test3()
'SEND EMAIL 2
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim rng As Range
Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
Set rng = Sheets("Sheet1").Range("A1:M87").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
'COLUMN E IS THE LINE MANAGER EMAIL
For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "A").Value) = "yes" _
And LCase(Cells(cell.Row, "B").Value) <> "send" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
'.To = "[email]deepak.saxena@bt.com[/email]"
.BCC = cell.Value
.Subject = "Alert for completing the survey"
'.Body = Sheets("Sheet1").Range("A1:A87").SpecialCells(xlCellTypeVisible)
.HTMLBody = RangetoHTML(rng)
.Send 'Or use Display
End With
On Error GoTo 0
Cells(cell.Row, "B").Value = "send"
Set OutMail = Nothing
End If
Next cell
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = True
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End FunctionPlease help in adding the right code for selecting everything from the sheet. Thanks!!
Last edited by a moderator:
