Hi,
I have created below code to paste table from excel to mail body of outlook.
Now i wanted to paste two charts (Sheet - Chart1 & Sheet 15-90 ) in mail body of outlook below table pasted in mail body.
Can anyone help me solve this code?
Thanks in Advance.
Sub SendODReportMail()
Dim outlookApp As Object
Dim outlookMailItem As Object
Dim MailBody As String
Dim rng As Range
Dim rng1 As Range
Set currentWB = ActiveWorkbook
currentWB.Activate
Sheets("Sheet1").Select
Set outlookApp = CreateObject("Outlook.Application")
Set outlookMailItem = outlookApp.CreateItem(0)
Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
Set rng1 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
RegardsName = "Dipashree"
MailBody = "Dear Sir," & "<br>" & "<br>" _
& "Please find attached sheet. " & "<br>" _
& RangetoHTML(rng) & "<br>" _
& RangetoHTML1(rng1) & "<br>" _
& "<br>" & "<br>" _
& "Regards" & "<br>" _
& RegardsName & "<br>" _
With outlookMailItem
.To = ""
.CC = ""
.BCC = ""
.HTMLBody = MailBody
.Subject = "Zone 5 OD Ageing Report OD Report " & Date
'.Attachments.Add TempWorkbook.FullName
.Display
End With
Set outlookMailItem = Nothing
Set outlookApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
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"
'currentWB.Activate
Sheets("Sheet1").Select
Range("A7:A7").Select
ActiveSheet.ShowAllData
'Turn off screen updating
Application.ScreenUpdating = False
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Sales Manager")
.PivotItems("Anubhav").Visible = True
.PivotItems("Mithun (Chennai)").Visible = True
.PivotItems("Mithun Muddappa").Visible = True
.PivotItems("Nitin Priyadarshi").Visible = True
.PivotItems("Sandeep Chavan").Visible = True
.PivotItems("sudip das").Visible = True
.PivotItems("Vikas Sawant").Visible = True
.PivotItems("Vikas-HYD").Visible = True
.PivotItems("0").Visible = True
.PivotItems("accounts").Visible = True
.PivotItems("Ajit Acharekar").Visible = True
.PivotItems("Dhiraj Kumar").Visible = True
.PivotItems("Lavin").Visible = True
.PivotItems("Swati").Visible = True
.PivotItems("Vivek Soni").Visible = True
.PivotItems("(blank)").Visible = False
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Employee respons.")
.Orientation = xlRowField
.Position = 3
End With
'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, , True, False
ActiveCell.SpecialCells(xlLastCell).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Columns.AutoFit
Selection.Borders.LineStyle = xlContinuous
.Cells(1).Select
Range("A6").Select
Application.CutCopyMode = False
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 xublishsource=", _
"align=left xublishsource=")
'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 Function
Function RangetoHTML1(rng1 As Range)
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"
'currentWB.Activate
Sheets("Sheet1").Select
Range("A7:A7").Select
ActiveSheet.ShowAllData
'Turn off screen updating
Application.ScreenUpdating = False
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Sales Manager")
.PivotItems("Anubhav").Visible = True
.PivotItems("Mithun (Chennai)").Visible = True
.PivotItems("Mithun Muddappa").Visible = True
.PivotItems("Nitin Priyadarshi").Visible = True
.PivotItems("Sandeep Chavan").Visible = True
.PivotItems("sudip das").Visible = True
.PivotItems("Vikas Sawant").Visible = True
.PivotItems("Vikas-HYD").Visible = True
.PivotItems("0").Visible = True
.PivotItems("accounts").Visible = True
.PivotItems("Ajit Acharekar").Visible = True
.PivotItems("Dhiraj Kumar").Visible = True
.PivotItems("Lavin").Visible = True
.PivotItems("Swati").Visible = True
.PivotItems("Vivek Soni").Visible = True
.PivotItems("(blank)").Visible = False
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Employee respons.")
.Orientation = xlHidden
End With
'Copy the range and create a new workbook to past the data in
rng1.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, , True, False
ActiveCell.SpecialCells(xlLastCell).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Columns.AutoFit
Selection.Borders.LineStyle = xlContinuous
.Cells(1).Select
Range("A6").Select
Application.CutCopyMode = False
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)
RangetoHTML1 = ts.readall
ts.Close
RangetoHTML1 = Replace(RangetoHTML1, "align=center xublishsource=", _
"align=left xublishsource=")
'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 Function
I have created below code to paste table from excel to mail body of outlook.
Now i wanted to paste two charts (Sheet - Chart1 & Sheet 15-90 ) in mail body of outlook below table pasted in mail body.
Can anyone help me solve this code?
Thanks in Advance.
Sub SendODReportMail()
Dim outlookApp As Object
Dim outlookMailItem As Object
Dim MailBody As String
Dim rng As Range
Dim rng1 As Range
Set currentWB = ActiveWorkbook
currentWB.Activate
Sheets("Sheet1").Select
Set outlookApp = CreateObject("Outlook.Application")
Set outlookMailItem = outlookApp.CreateItem(0)
Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
Set rng1 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
RegardsName = "Dipashree"
MailBody = "Dear Sir," & "<br>" & "<br>" _
& "Please find attached sheet. " & "<br>" _
& RangetoHTML(rng) & "<br>" _
& RangetoHTML1(rng1) & "<br>" _
& "<br>" & "<br>" _
& "Regards" & "<br>" _
& RegardsName & "<br>" _
With outlookMailItem
.To = ""
.CC = ""
.BCC = ""
.HTMLBody = MailBody
.Subject = "Zone 5 OD Ageing Report OD Report " & Date
'.Attachments.Add TempWorkbook.FullName
.Display
End With
Set outlookMailItem = Nothing
Set outlookApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
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"
'currentWB.Activate
Sheets("Sheet1").Select
Range("A7:A7").Select
ActiveSheet.ShowAllData
'Turn off screen updating
Application.ScreenUpdating = False
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Sales Manager")
.PivotItems("Anubhav").Visible = True
.PivotItems("Mithun (Chennai)").Visible = True
.PivotItems("Mithun Muddappa").Visible = True
.PivotItems("Nitin Priyadarshi").Visible = True
.PivotItems("Sandeep Chavan").Visible = True
.PivotItems("sudip das").Visible = True
.PivotItems("Vikas Sawant").Visible = True
.PivotItems("Vikas-HYD").Visible = True
.PivotItems("0").Visible = True
.PivotItems("accounts").Visible = True
.PivotItems("Ajit Acharekar").Visible = True
.PivotItems("Dhiraj Kumar").Visible = True
.PivotItems("Lavin").Visible = True
.PivotItems("Swati").Visible = True
.PivotItems("Vivek Soni").Visible = True
.PivotItems("(blank)").Visible = False
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Employee respons.")
.Orientation = xlRowField
.Position = 3
End With
'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, , True, False
ActiveCell.SpecialCells(xlLastCell).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Columns.AutoFit
Selection.Borders.LineStyle = xlContinuous
.Cells(1).Select
Range("A6").Select
Application.CutCopyMode = False
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 xublishsource=", _
"align=left xublishsource=")
'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 Function
Function RangetoHTML1(rng1 As Range)
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"
'currentWB.Activate
Sheets("Sheet1").Select
Range("A7:A7").Select
ActiveSheet.ShowAllData
'Turn off screen updating
Application.ScreenUpdating = False
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Sales Manager")
.PivotItems("Anubhav").Visible = True
.PivotItems("Mithun (Chennai)").Visible = True
.PivotItems("Mithun Muddappa").Visible = True
.PivotItems("Nitin Priyadarshi").Visible = True
.PivotItems("Sandeep Chavan").Visible = True
.PivotItems("sudip das").Visible = True
.PivotItems("Vikas Sawant").Visible = True
.PivotItems("Vikas-HYD").Visible = True
.PivotItems("0").Visible = True
.PivotItems("accounts").Visible = True
.PivotItems("Ajit Acharekar").Visible = True
.PivotItems("Dhiraj Kumar").Visible = True
.PivotItems("Lavin").Visible = True
.PivotItems("Swati").Visible = True
.PivotItems("Vivek Soni").Visible = True
.PivotItems("(blank)").Visible = False
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Employee respons.")
.Orientation = xlHidden
End With
'Copy the range and create a new workbook to past the data in
rng1.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, , True, False
ActiveCell.SpecialCells(xlLastCell).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Columns.AutoFit
Selection.Borders.LineStyle = xlContinuous
.Cells(1).Select
Range("A6").Select
Application.CutCopyMode = False
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)
RangetoHTML1 = ts.readall
ts.Close
RangetoHTML1 = Replace(RangetoHTML1, "align=center xublishsource=", _
"align=left xublishsource=")
'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 Function